1{-# LANGUAGE QuasiQuotes #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE CPP #-}
6-- | Provide the user with a rich text editor.
7--
8-- According to NIC editor homepage it is not actively maintained since June
9-- 2012.  There is another better alternative — open sourced Summernote editor
10-- released under MIT licence.  You can use Summernote in your Yesod forms via
11-- separately distributed
12-- <http://hackage.haskell.org/package/yesod-form-richtext yesod-form-richtext>
13-- package.
14module Yesod.Form.Nic
15    ( YesodNic (..)
16    , nicHtmlField
17    ) where
18
19import Yesod.Core
20import Yesod.Form
21import Text.HTML.SanitizeXSS (sanitizeBalance)
22import Text.Julius (rawJS)
23import Text.Blaze.Html.Renderer.String (renderHtml)
24import Data.Text (Text, pack)
25import Data.Maybe (listToMaybe)
26
27class Yesod a => YesodNic a where
28    -- | NIC Editor Javascript file.
29    urlNicEdit :: a -> Either (Route a) Text
30    urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
31
32nicHtmlField :: YesodNic site => Field (HandlerFor site) Html
33nicHtmlField = Field
34    { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
35    , fieldView = \theId name attrs val _isReq -> do
36        toWidget [shamlet|
37$newline never
38    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
39|]
40        addScript' urlNicEdit
41        master <- getYesod
42        toWidget $
43          case jsLoader master of
44            BottomOfHeadBlocking -> [julius|
45bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});
46|]
47            _ -> [julius|
48(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();
49|]
50    , fieldEnctype = UrlEncoded
51    }
52  where
53    showVal = either id (pack . renderHtml)
54
55addScript' :: (MonadWidget m, HandlerSite m ~ site)
56           => (site -> Either (Route site) Text)
57           -> m ()
58addScript' f = do
59    y <- getYesod
60    addScriptEither $ f y
61