{-# language QuasiQuotes #-}
{-# language RecordWildCards #-}

module FlexTask.ConvertForm (
  getFormData,
  ) where


import qualified Yesod.Core.Unsafe      as Unsafe

import Control.Monad.Reader             (runReader)
import Data.Map                         (fromList)
import Data.IORef                       (readIORef, writeIORef)
import Data.Text                        (Text)
import System.Log.FastLogger            (defaultBufSize, newStdoutLoggerSet)
import Text.Blaze.Html.Renderer.String  (renderHtml)
import Yesod
import Yesod.Core.Types                 (HandlerData(..), HandlerFor(..), ghsIdent)
import Yesod.Default.Config2            (makeYesodLogger)

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



-- 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 -> Handler a -> Handler 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 -> Handler a -> Handler a
setRequestLang :: forall a. Lang -> Handler a -> Handler 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
handlerResource :: forall child site. HandlerData child site -> InternalState
handlerEnv :: forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerRequest :: forall child site. HandlerData child site -> YesodRequest
..} =
      HandlerData child site
hd{handlerRequest = handlerRequest{reqLangs = [lang]}}