{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | Provide the user with a rich text editor.
--
-- According to NIC editor homepage it is not actively maintained since June
-- 2012.  There is another better alternative — open sourced Summernote editor
-- released under MIT licence.  You can use Summernote in your Yesod forms via
-- separately distributed
-- <http://hackage.haskell.org/package/yesod-form-richtext yesod-form-richtext>
-- package.
module Yesod.Form.Nic
    ( YesodNic (..)
    , nicHtmlField
    ) where

import Yesod.Core
import Yesod.Form
import Text.HTML.SanitizeXSS (sanitizeBalance)
import Text.Julius (rawJS)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Data.Text (Text, pack)
import Data.Maybe (listToMaybe)

class Yesod a => YesodNic a where
    -- | NIC Editor Javascript file.
    urlNicEdit :: a -> Either (Route a) Text
    urlNicEdit a
_ = forall a b. b -> Either a b
Right Text
"http://js.nicedit.com/nicEdit-latest.js"

nicHtmlField :: YesodNic site => Field (HandlerFor site) Html
nicHtmlField :: forall site. YesodNic site => Field (HandlerFor site) Html
nicHtmlField = Field
    { fieldParse :: [Text]
-> [FileInfo]
-> HandlerFor
     site
     (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html))
fieldParse = \[Text]
e [FileInfo]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToMarkup a => a -> Html
preEscapedToMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
sanitizeBalance) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ [Text]
e
    , fieldView :: FieldViewFunc (HandlerFor site) Html
fieldView = \Text
theId Text
name [(Text, Text)]
attrs Either Text Html
val Bool
_isReq -> do
        forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [shamlet|
$newline never
    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
|]
        forall (m :: * -> *) site.
(MonadWidget m, HandlerSite m ~ site) =>
(site -> Either (Route site) Text) -> m ()
addScript' forall a. YesodNic a => a -> Either (Route a) Text
urlNicEdit
        site
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
        forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget forall a b. (a -> b) -> a -> b
$
          case forall site. Yesod site => site -> ScriptLoadPosition site
jsLoader site
master of
            ScriptLoadPosition site
BottomOfHeadBlocking -> [julius|
bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});
|]
            ScriptLoadPosition site
_ -> [julius|
(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();
|]
    , fieldEnctype :: Enctype
fieldEnctype = Enctype
UrlEncoded
    }
  where
    showVal :: Either Text Html -> Text
showVal = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> String
renderHtml)

addScript' :: (MonadWidget m, HandlerSite m ~ site)
           => (site -> Either (Route site) Text)
           -> m ()
addScript' :: forall (m :: * -> *) site.
(MonadWidget m, HandlerSite m ~ site) =>
(site -> Either (Route site) Text) -> m ()
addScript' site -> Either (Route site) Text
f = do
    site
y <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    forall (m :: * -> *).
MonadWidget m =>
Either (Route (HandlerSite m)) Text -> m ()
addScriptEither forall a b. (a -> b) -> a -> b
$ site -> Either (Route site) Text
f site
y