{-# language OverloadedStrings #-}
{-# language QuasiQuotes #-}
{-# language RecordWildCards #-}
{-# language TypeOperators #-}

{- | Functions for creating and composing forms.
-}

module FlexTask.FormUtil
  (
  -- * Functions for Rendered
    ($$>)
  , addCss
  , addJs
  , addCssAndJs
  , applyToWidget
  , getFormData
  -- * Convenience functions for Yesod FieldSettings
  , addAttribute
  , addAttributes
  , addCssClass
  , addNameAndCssClass
  , readOnly
  -- * Convenience for internationalization
  , universalLabel
  , showToUniversalLabel
  -- * functions for custom forms
  , newFlexId
  , newFlexName
  , repeatFlexName
  ) where



import Control.Monad.Reader            (runReader)
import Data.Containers.ListUtils       (nubOrd)
import Data.IORef                      (readIORef, writeIORef)
import Data.Map                        (fromList)
import Data.String                     (fromString)
import Data.Text                       (Text, pack)
import Data.Tuple.Extra                (second)
import System.Log.FastLogger           (defaultBufSize, newStdoutLoggerSet)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.Cassius                    (Css)
import Text.Julius                     (Javascript)
import Yesod
import Yesod.Core.Types                (HandlerData(..), HandlerFor(..), RY, ghsIdent)
import Yesod.Default.Config2           (makeYesodLogger)

import qualified Control.Monad.Trans.RWS as RWS   (get)
import qualified Data.Text               as T     (replace)
import qualified Yesod.Core.Unsafe       as Unsafe

import FlexTask.Types                  (HtmlDict)
import FlexTask.Processing.Text        (supportedLanguages)
import FlexTask.YesodConfig (
  FlexForm(..),
  Handler,
  Rendered,
  Rendered',
  Widget,
  )




{- |
Compose two forms sequentially.
The output form contains all of the fields from both input forms.
-}
infixr 0 $$>
($$>)
  :: (Monad w, Monad m)
  => Rendered' m (w a)
  -> Rendered' m (w b)
  -> Rendered' m (w b)
Rendered' m (w a)
f1 $$> :: forall (w :: * -> *) (m :: * -> *) a b.
(Monad w, Monad m) =>
Rendered' m (w a) -> Rendered' m (w b) -> Rendered' m (w b)
$$> Rendered' m (w b)
f2 = do
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  ([Lang], w a)
res1 <- Rendered' m (w a)
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w a))
f1
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  ([Lang], w b)
res2 <- Rendered' m (w b)
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w b))
f2
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  ([Lang], w b)
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        (HandlerFor FlexForm)
        ([Lang], w b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RWST
   (Maybe (Env, FileEnv), FlexForm, [Lang])
   Enctype
   Ints
   (HandlerFor FlexForm)
   ([Lang], w b)
 -> m (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         (HandlerFor FlexForm)
         ([Lang], w b)))
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w b)
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        (HandlerFor FlexForm)
        ([Lang], w b))
forall a b. (a -> b) -> a -> b
$ do
      ([Lang]
names1,w a
wid1) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  ([Lang], w a)
res1
      ([Lang]
names2,w b
wid2) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  ([Lang], w b)
res2
      ([Lang], w b)
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w b)
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Lang] -> [Lang]
forall a. Ord a => [a] -> [a]
nubOrd ([Lang] -> [Lang]) -> [Lang] -> [Lang]
forall a b. (a -> b) -> a -> b
$ [Lang]
names1 [Lang] -> [Lang] -> [Lang]
forall a. [a] -> [a] -> [a]
++ [Lang]
names2, w a
wid1 w a -> w b -> w b
forall a b. w a -> w b -> w b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> w b
wid2)


{- |
Apply some function to the embedded widget of a `Rendered` value.
-}
applyToWidget :: Functor m => (w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget :: forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget w -> w'
f Rendered' m w
form = (([Lang], w) -> ([Lang], w'))
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w)
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w')
forall a b.
(a -> b)
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((w -> w') -> ([Lang], w) -> ([Lang], w')
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second w -> w'
f) (RWST
   (Maybe (Env, FileEnv), FlexForm, [Lang])
   Enctype
   Ints
   (HandlerFor FlexForm)
   ([Lang], w)
 -> RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      (HandlerFor FlexForm)
      ([Lang], w'))
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        (HandlerFor FlexForm)
        ([Lang], w))
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        (HandlerFor FlexForm)
        ([Lang], w'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rendered' m w
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], w))
form


addContent
  :: (ToWidget FlexForm (render -> a), Functor m)
  => (render -> a)
  -> Rendered' m Widget
  -> Rendered' m Widget
addContent :: forall render a (m :: * -> *).
(ToWidget FlexForm (render -> a), Functor m) =>
(render -> a) -> Rendered' m Widget -> Rendered' m Widget
addContent render -> a
content = (Widget -> Widget) -> Rendered' m Widget -> Rendered' m Widget
forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget (Widget -> Widget -> Widget
forall a b.
WidgetFor FlexForm a
-> WidgetFor FlexForm b -> WidgetFor FlexForm a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (render -> a) -> Widget
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ FlexForm) =>
(render -> a) -> m ()
toWidget render -> a
content)


{- |
Add CSS to a form.
Use with `Yesod` Cassius or Lucius Shakespeare quasi quoters or hosted files.
-}
addCss
  :: (render ~ RY FlexForm, Functor m)
  => (render -> Css)      -- ^ CSS template
  -> Rendered' m Widget -- ^ Form to add to
  -> Rendered' m Widget
addCss :: forall render (m :: * -> *).
(render ~ RY FlexForm, Functor m) =>
(render -> Css) -> Rendered' m Widget -> Rendered' m Widget
addCss = (render -> Css) -> Rendered' m Widget -> Rendered' m Widget
forall render a (m :: * -> *).
(ToWidget FlexForm (render -> a), Functor m) =>
(render -> a) -> Rendered' m Widget -> Rendered' m Widget
addContent


{- |
Add JavaScript to a form.
Use with `Yesod` Julius Shakespeare quasi quoters or hosted files.
-}
addJs
  :: (render ~ RY FlexForm, Functor m)
  => (render -> Javascript) -- ^ Javascript template
  -> Rendered' m Widget -- ^ Form to add to
  -> Rendered' m Widget
addJs :: forall render (m :: * -> *).
(render ~ RY FlexForm, Functor m) =>
(render -> Javascript) -> Rendered' m Widget -> Rendered' m Widget
addJs = (render -> Javascript) -> Rendered' m Widget -> Rendered' m Widget
forall render a (m :: * -> *).
(ToWidget FlexForm (render -> a), Functor m) =>
(render -> a) -> Rendered' m Widget -> Rendered' m Widget
addContent


{- |
Like `addCss` and `addJs`, but for including CSS and JavaScript in one step.
-}
addCssAndJs
  :: (render ~ RY FlexForm, Functor m)
  => (render -> Css)        -- ^ CSS template
  -> (render -> Javascript) -- ^ Javascript template
  -> Rendered' m Widget -- ^ Form to add to
  -> Rendered' m Widget
addCssAndJs :: forall render (m :: * -> *).
(render ~ RY FlexForm, Functor m) =>
(render -> Css)
-> (render -> Javascript)
-> Rendered' m Widget
-> Rendered' m Widget
addCssAndJs render -> Css
css render -> Javascript
js = (Widget -> Widget) -> Rendered' m Widget -> Rendered' m Widget
forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget ((Widget -> Widget -> Widget
forall a b.
WidgetFor FlexForm a
-> WidgetFor FlexForm b -> WidgetFor FlexForm a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (render -> Css) -> Widget
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ FlexForm) =>
(render -> Css) -> m ()
toWidget render -> Css
css) (Widget -> Widget) -> (Widget -> Widget) -> Widget -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget -> Widget -> Widget
forall a b.
WidgetFor FlexForm a
-> WidgetFor FlexForm b -> WidgetFor FlexForm a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (render -> Javascript) -> Widget
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ FlexForm) =>
(render -> Javascript) -> m ()
toWidget render -> Javascript
js))


{- |
Convenience function to directly create a Yesod FieldSetting with this name and CSS Class.
-}
addNameAndCssClass :: Text -> Text -> FieldSettings app
addNameAndCssClass :: forall app. Lang -> Lang -> FieldSettings app
addNameAndCssClass Lang
name Lang
cssClass = FieldSettings app
forall {master}. FieldSettings master
addFieldAttrs
  where
    fSettings :: FieldSettings site
fSettings = Lang -> FieldSettings site
forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
fieldSettingsLabel Lang
name
    addFieldAttrs :: FieldSettings master
addFieldAttrs = FieldSettings master
forall {master}. FieldSettings master
fSettings {
      fsName = Just name,
      fsAttrs = addClass cssClass $ fsAttrs fSettings
      }


-- | Add an attribute-value pair to the given FieldSettings
addAttribute :: (Text,Text) -> FieldSettings app -> FieldSettings app
addAttribute :: forall app. (Lang, Lang) -> FieldSettings app -> FieldSettings app
addAttribute (Lang, Lang)
attribute FieldSettings app
fs =  FieldSettings app
fs { fsAttrs = attribute : fsAttrs fs}


-- | Add a list of attribute-value pairs to the given FieldSettings
addAttributes :: [(Text,Text)] -> FieldSettings app -> FieldSettings app
addAttributes :: forall app.
[(Lang, Lang)] -> FieldSettings app -> FieldSettings app
addAttributes [(Lang, Lang)]
as FieldSettings app
fs =  FieldSettings app
fs { fsAttrs = as ++ fsAttrs fs}


-- | Add a CSS class to the given FieldSettings
addCssClass :: Text -> FieldSettings app -> FieldSettings app
addCssClass :: forall app. Lang -> FieldSettings app -> FieldSettings app
addCssClass Lang
c FieldSettings app
fs = FieldSettings app
fs { fsAttrs = addClass c $ fsAttrs fs}


-- | Turn FieldSettings into a read-only input field
readOnly :: FieldSettings app -> FieldSettings app
readOnly :: forall app. FieldSettings app -> FieldSettings app
readOnly = [(Lang, Lang)] -> FieldSettings app -> FieldSettings app
forall app.
[(Lang, Lang)] -> FieldSettings app -> FieldSettings app
addAttributes [(Lang
"readonly",Lang
""),(Lang
"style",Lang
"background-color: #EEEEEE")]


-- | Turn a String into a label for all languages.
universalLabel :: String -> SomeMessage FlexForm
universalLabel :: String -> SomeMessage FlexForm
universalLabel = String -> SomeMessage FlexForm
forall a. IsString a => String -> a
fromString


-- | Turn the Show instance of a value into a label for all languages
showToUniversalLabel :: Show a => a -> SomeMessage FlexForm
showToUniversalLabel :: forall a. Show a => a -> SomeMessage FlexForm
showToUniversalLabel = String -> SomeMessage FlexForm
universalLabel (String -> SomeMessage FlexForm)
-> (a -> String) -> a -> SomeMessage FlexForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


{- |
Get a unique identifier for an html element.
The format is "flexident[number]"
-}
newFlexId :: MForm Handler Text
newFlexId :: MForm (HandlerFor FlexForm) Lang
newFlexId = HasCallStack => Lang -> Lang -> Lang -> Lang
Lang -> Lang -> Lang -> Lang
T.replace Lang
"h" Lang
"flex" (Lang -> Lang)
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  Lang
forall (m :: * -> *). MonadHandler m => m Lang
newIdent


-- | repeat the last received name.
repeatFlexName :: MForm Handler Text
repeatFlexName :: MForm (HandlerFor FlexForm) Lang
repeatFlexName = do
  Ints
i <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  Ints
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWS.get
  Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lang
 -> RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      (HandlerFor FlexForm)
      Lang)
-> Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
forall a b. (a -> b) -> a -> b
$ String -> Lang
pack (String -> Lang) -> String -> Lang
forall a b. (a -> b) -> a -> b
$ String
"flex" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ints -> String
forall a. Show a => a -> String
show Ints
i


{- |
Get a unique name for an html element.
The format is "flex[number]"
-}
newFlexName :: MForm Handler Text
newFlexName :: MForm (HandlerFor FlexForm) Lang
newFlexName = HasCallStack => Lang -> Lang -> Lang -> Lang
Lang -> Lang -> Lang -> Lang
T.replace Lang
"f" Lang
"flex" (Lang -> Lang)
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MForm (HandlerFor FlexForm) Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  (HandlerFor FlexForm)
  Lang
forall (m :: * -> *). Monad m => MForm m Lang
newFormIdent


-- reset internal id generator to have same ids in all languages
resetIdentGen :: Handler ()
resetIdentGen :: Handler ()
resetIdentGen = do
    GHState
x <- (HandlerData FlexForm FlexForm -> IO GHState)
-> HandlerFor FlexForm GHState
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData FlexForm FlexForm -> IO GHState)
 -> HandlerFor FlexForm GHState)
-> (HandlerData FlexForm FlexForm -> IO GHState)
-> HandlerFor FlexForm GHState
forall a b. (a -> b) -> a -> b
$ IORef GHState -> IO GHState
forall a. IORef a -> IO a
readIORef (IORef GHState -> IO GHState)
-> (HandlerData FlexForm FlexForm -> IORef GHState)
-> HandlerData FlexForm FlexForm
-> IO GHState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData FlexForm FlexForm -> IORef GHState
forall child site. HandlerData child site -> IORef GHState
handlerState
    (HandlerData FlexForm FlexForm -> IO ()) -> Handler ()
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData FlexForm FlexForm -> IO ()) -> Handler ())
-> (HandlerData FlexForm FlexForm -> IO ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ (IORef GHState -> GHState -> IO ())
-> GHState -> IORef GHState -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef GHState -> GHState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef GHState
x {ghsIdent = 0} (IORef GHState -> IO ())
-> (HandlerData FlexForm FlexForm -> IORef GHState)
-> HandlerData FlexForm FlexForm
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData FlexForm FlexForm -> IORef GHState
forall child site. HandlerData child site -> IORef GHState
handlerState


{- |
Extract a form from the environment.
The result is an IO embedded tuple of field IDs and a map of language and internationalized html pairs.
-}
getFormData :: Rendered Widget -> IO ([Text], HtmlDict)
getFormData :: Rendered Widget -> IO ([Lang], HtmlDict)
getFormData Rendered Widget
widget = do
    Logger
logger <- Int -> IO LoggerSet
newStdoutLoggerSet Int
defaultBufSize IO LoggerSet -> (LoggerSet -> IO Logger) -> IO Logger
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO Logger
makeYesodLogger
    (FlexForm -> Logger)
-> FlexForm
-> HandlerFor FlexForm ([Lang], HtmlDict)
-> IO ([Lang], HtmlDict)
forall site (m :: * -> *) a.
(Yesod site, MonadIO m) =>
(site -> Logger) -> site -> HandlerFor site a -> m a
Unsafe.fakeHandlerGetLogger
      FlexForm -> Logger
appLogger
      FlexForm {appLogger :: Logger
appLogger = Logger
logger}
      HandlerFor FlexForm ([Lang], HtmlDict)
writeHtml
  where
    writeHtml :: Handler ([Text], HtmlDict)
    writeHtml :: HandlerFor FlexForm ([Lang], HtmlDict)
writeHtml = case [Lang]
supportedLanguages of
      (Lang
l:[Lang]
ls) -> do
        ([Lang]
names,(Lang, String)
first) <- Lang -> Handler ([Lang], (Lang, String))
withLang Lang
l
        [(Lang, String)]
rest <- (Lang -> HandlerFor FlexForm (Lang, String))
-> [Lang] -> HandlerFor FlexForm [(Lang, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((([Lang], (Lang, String)) -> (Lang, String))
-> Handler ([Lang], (Lang, String))
-> HandlerFor FlexForm (Lang, String)
forall a b.
(a -> b) -> HandlerFor FlexForm a -> HandlerFor FlexForm b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Lang], (Lang, String)) -> (Lang, String)
forall a b. (a, b) -> b
snd (Handler ([Lang], (Lang, String))
 -> HandlerFor FlexForm (Lang, String))
-> (Lang -> Handler ([Lang], (Lang, String)))
-> Lang
-> HandlerFor FlexForm (Lang, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Handler ([Lang], (Lang, String))
withLang) [Lang]
ls
        ([Lang], HtmlDict) -> HandlerFor FlexForm ([Lang], HtmlDict)
forall a. a -> HandlerFor FlexForm a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Lang]
names, [(Lang, String)] -> HtmlDict
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Lang, String)] -> HtmlDict) -> [(Lang, String)] -> HtmlDict
forall a b. (a -> b) -> a -> b
$ (Lang, String)
first(Lang, String) -> [(Lang, String)] -> [(Lang, String)]
forall a. a -> [a] -> [a]
:[(Lang, String)]
rest)
      [Lang]
_ -> String -> HandlerFor FlexForm ([Lang], HtmlDict)
forall a. HasCallStack => String -> a
error String
"No supported languages found!"

    withLang :: Lang -> Handler ([Text], (Lang, String))
    withLang :: Lang -> Handler ([Lang], (Lang, String))
withLang Lang
lang = Lang
-> Handler ([Lang], (Lang, String))
-> Handler ([Lang], (Lang, String))
forall a. Lang -> HandlerFor FlexForm a -> HandlerFor FlexForm a
setRequestLang Lang
lang (Handler ([Lang], (Lang, String))
 -> Handler ([Lang], (Lang, String)))
-> Handler ([Lang], (Lang, String))
-> Handler ([Lang], (Lang, String))
forall a b. (a -> b) -> a -> b
$ do
      Handler ()
resetIdentGen
      ([Lang]
names,Widget
wid) <- (([Lang], Widget), Enctype) -> ([Lang], Widget)
forall a b. (a, b) -> a
fst ((([Lang], Widget), Enctype) -> ([Lang], Widget))
-> HandlerFor FlexForm (([Lang], Widget), Enctype)
-> HandlerFor FlexForm ([Lang], Widget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Markup -> MForm (HandlerFor FlexForm) ([Lang], Widget))
-> HandlerFor FlexForm (([Lang], Widget), Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormGet (Reader
  Markup
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], Widget))
-> Markup
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], Widget)
forall r a. Reader r a -> r -> a
runReader Rendered Widget
Reader
  Markup
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([Lang], Widget))
widget)
      PageContent (Route FlexForm)
content <- Widget -> HandlerFor FlexForm (PageContent (Route FlexForm))
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site (PageContent (Route site))
widgetToPageContent Widget
wid
      Markup
html <- ((Route (HandlerSite (HandlerFor FlexForm))
  -> [(Lang, Lang)] -> Lang)
 -> Markup)
-> HandlerFor FlexForm Markup
forall (m :: * -> *) output.
MonadHandler m =>
((Route (HandlerSite m) -> [(Lang, Lang)] -> Lang) -> output)
-> m output
withUrlRenderer (Route (HandlerSite (HandlerFor FlexForm))
 -> [(Lang, Lang)] -> Lang)
-> Markup
[hamlet|
        ^{pageHead content}
        ^{pageBody content}|]
      ([Lang], (Lang, String)) -> Handler ([Lang], (Lang, String))
forall a. a -> HandlerFor FlexForm a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Lang]
names, (Lang
lang, [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Markup -> String
renderHtml Markup
html))



-- Manipulate the request data to use a specific language.
setRequestLang :: Lang -> HandlerFor FlexForm a -> HandlerFor FlexForm a
setRequestLang :: forall a. Lang -> HandlerFor FlexForm a -> HandlerFor FlexForm a
setRequestLang Lang
lang HandlerFor{HandlerData FlexForm FlexForm -> IO a
unHandlerFor :: HandlerData FlexForm FlexForm -> IO a
unHandlerFor :: forall site a. HandlerFor site a -> HandlerData site site -> IO a
..} = do
  (HandlerData FlexForm FlexForm -> IO a) -> HandlerFor FlexForm a
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData FlexForm FlexForm -> IO a) -> HandlerFor FlexForm a)
-> (HandlerData FlexForm FlexForm -> IO a) -> HandlerFor FlexForm a
forall a b. (a -> b) -> a -> b
$ HandlerData FlexForm FlexForm -> IO a
unHandlerFor (HandlerData FlexForm FlexForm -> IO a)
-> (HandlerData FlexForm FlexForm -> HandlerData FlexForm FlexForm)
-> HandlerData FlexForm FlexForm
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData FlexForm FlexForm -> HandlerData FlexForm FlexForm
forall {child} {site}.
HandlerData child site -> HandlerData child site
alterHandlerData
  where
    alterHandlerData :: HandlerData child site -> HandlerData child site
alterHandlerData hd :: HandlerData child site
hd@HandlerData{InternalState
IORef GHState
YesodRequest
RunHandlerEnv child site
handlerState :: forall child site. HandlerData child site -> IORef GHState
handlerRequest :: YesodRequest
handlerEnv :: RunHandlerEnv child site
handlerState :: IORef GHState
handlerResource :: InternalState
handlerEnv :: forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerRequest :: forall child site. HandlerData child site -> YesodRequest
handlerResource :: forall child site. HandlerData child site -> InternalState
..} =
      HandlerData child site
hd{handlerRequest = handlerRequest{reqLangs = [lang]}}