    {-# 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
    _ = Text -> Either (Route a) Text
    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]
    _ -> Either (SomeMessage site) (Maybe Html)
    -> HandlerFor site (Either (SomeMessage site) (Maybe Html))
    Either (SomeMessage site) (Maybe Html)
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html))
    forall a. a -> HandlerFor site a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (SomeMessage site) (Maybe Html)
     -> HandlerFor
          site
          (Either
             (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html)))
    -> ([Text] -> Either (SomeMessage site) (Maybe Html))
    -> [Text]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Html -> Either (SomeMessage site) (Maybe Html)
    forall a b. b -> Either a b
    Right (Maybe Html -> Either (SomeMessage site) (Maybe Html))
    -> ([Text] -> Maybe Html)
    -> [Text]
    -> Either (SomeMessage site) (Maybe Html)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Html) -> Maybe Text -> Maybe Html
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> Html
    forall a. ToMarkup a => a -> Html
    preEscapedToMarkup (Text -> Html) -> (Text -> Text) -> Text -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    sanitizeBalance) (Maybe Text -> Maybe Html)
    -> ([Text] -> Maybe Text) -> [Text] -> Maybe Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Maybe Text
    forall a. [a] -> Maybe a
    listToMaybe ([Text]
     -> HandlerFor
          site
          (Either
             (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html)))
    -> [Text]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Html))
    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
            Html -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    Html -> m ()
    toWidget [shamlet|
    $newline never
        <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
    |]
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (MonadWidget m, HandlerSite m ~ site) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    forall a. YesodNic a => a -> Either (Route a) Text
    urlNicEdit
            master <- WidgetFor site site
    WidgetFor site (HandlerSite (WidgetFor site))
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
            toWidget $
              case jsLoader 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 = (Text -> Text) -> (Html -> Text) -> Either Text Html -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Text
    forall a. a -> a
    id (String -> Text
    pack (String -> Text) -> (Html -> String) -> Html -> Text
    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
        y <- m site
    m (HandlerSite m)
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
        addScriptEither $ f y