{-# 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 :: Field (HandlerFor site) Html
nicHtmlField = Field :: forall (m :: * -> *) a.
([Text]
 -> [FileInfo]
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe a)))
-> FieldViewFunc m a -> Enctype -> Field m a
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))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage site) (Maybe Html)
 -> HandlerFor site (Either (SomeMessage site) (Maybe Html)))
-> ([Text] -> Either (SomeMessage site) (Maybe Html))
-> [Text]
-> HandlerFor site (Either (SomeMessage 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 (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 site) (Maybe Html)))
-> [Text]
-> HandlerFor site (Either (SomeMessage 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 ()
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
        site
master <- WidgetFor site site
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
        JavascriptUrl (Route site) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget (JavascriptUrl (Route site) -> WidgetFor site ())
-> JavascriptUrl (Route site) -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$
          case site -> ScriptLoadPosition site
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 = (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' :: (site -> Either (Route site) Text) -> m ()
addScript' site -> Either (Route site) Text
f = do
    site
y <- m site
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    Either (Route (HandlerSite m)) Text -> m ()
forall (m :: * -> *).
MonadWidget m =>
Either (Route (HandlerSite m)) Text -> m ()
addScriptEither (Either (Route (HandlerSite m)) Text -> m ())
-> Either (Route (HandlerSite m)) Text -> m ()
forall a b. (a -> b) -> a -> b
$ site -> Either (Route site) Text
f site
y