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

module FlexTask.ConvertForm (
  getFormData,
  unsafeGetFormData,
  ) 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.IO.Unsafe                 (unsafePerformIO)
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
    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
    HandlerFor $ flip writeIORef x {ghsIdent = 0} . handlerState


{- |
Extract a form from the environment inside an IO context.
The result is a tuple of field IDs and a map of language and internationalized html pairs.

This is an internal function used in the Autotool Flex-Task implementation.
You should never need to call this function yourself.
Use `unsafeGetFormData` instead.
-}
getFormData :: Rendered Widget -> IO ([[Text]], HtmlDict)
getFormData :: Rendered Widget -> IO ([[Lang]], HtmlDict)
getFormData Rendered Widget
widget = do
    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
    Unsafe.fakeHandlerGetLogger
      appLogger
      FlexForm {appLogger = logger}
      writeHtml
  where
    writeHtml :: Handler ([[Text]], HtmlDict)
    writeHtml :: HandlerFor FlexForm ([[Lang]], HtmlDict)
writeHtml = case [Lang]
supportedLanguages of
      (Lang
l:[Lang]
ls) -> do
        (names,first) <- Lang -> Handler ([[Lang]], (Lang, String))
withLang Lang
l
        rest <- traverse (fmap snd . withLang) ls
        return (names, fromList $ first: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
      (names,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)
      content <- widgetToPageContent wid
      html <- withUrlRenderer [hamlet|
        ^{pageHead content}
        ^{pageBody content}|]
      return (names, (lang, concat $ lines $ renderHtml html))


{- |
Extract a form from the environment.
The result is a tuple of field IDs and a map of language and internationalized html pairs.

Intended to be used for Autotool's task interface.

__Warning: This function employs `unsafePerformIO`!__
It should nevertheless be safe to use
as long as no lifted IO actions are executed while building the `Rendered` `Widget` argument.
This will always be the case for generic forms.
For custom forms, the user is responsible for making sure such calls are avoided or considered "safe".
-}
unsafeGetFormData :: Rendered Widget -> ([[Text]], HtmlDict)
unsafeGetFormData :: Rendered Widget -> ([[Lang]], HtmlDict)
unsafeGetFormData = IO ([[Lang]], HtmlDict) -> ([[Lang]], HtmlDict)
forall a. IO a -> a
unsafePerformIO (IO ([[Lang]], HtmlDict) -> ([[Lang]], HtmlDict))
-> (Reader
      Markup
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         (HandlerFor FlexForm)
         ([[Lang]], Widget))
    -> IO ([[Lang]], HtmlDict))
-> Reader
     Markup
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        (HandlerFor FlexForm)
        ([[Lang]], Widget))
-> ([[Lang]], HtmlDict)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rendered Widget -> IO ([[Lang]], HtmlDict)
Reader
  Markup
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     (HandlerFor FlexForm)
     ([[Lang]], Widget))
-> IO ([[Lang]], HtmlDict)
getFormData


-- 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]}}