{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
-- | Shuttle parsed form data to Ginger's dynamically-typed datamodel.
module Text.HTML.Form.WebApp.Ginger(template, template', resolveSource, list') where

import Text.HTML.Form
import Text.HTML.Form.Query (renderQueryString')

import FileEmbedLzma
import Data.FileEmbed
import System.FilePath

import Text.Ginger.Parse (parseGingerFile, SourcePos)
import Text.Ginger.Run (runGinger, makeContextHtml, Run)
import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>),
        fromFunction, Function)
import Text.Ginger.Html (Html, htmlSource, unsafeRawHtml)
import Control.Monad.Writer.Lazy (Writer)

import Data.Text as Txt
import Data.Text.Encoding as Txt
import Data.Text.Lazy as Txt (toStrict)
import Data.ByteString.Char8 as B8
import Network.URI (uriToString, escapeURIString, isUnescapedInURIComponent, nullURI)
import Text.XML (Document(..), Element(..), Prologue(..), Node, def, renderText)

import Data.List (nub)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Map as M

import Text.HTML.Form.Validate (inputErrorMessage')
import Text.HTML.Form.Query (applyQuery)
import Text.HTML.Form.I18n (stringsJSON)

-- | A key-value query string.
type Query = [(ByteString, Maybe ByteString)]
-- | Run the given template with the given Bureaucromancy data.
template :: Monad m => String -> Form -> Int -> Input -> Query ->
        m (Maybe (Either Query Text))
template :: forall (m :: * -> *).
Monad m =>
FilePath
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template FilePath
name Form
form Int
ix Input
input Query
query =
    FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' FilePath
name Form
form Int
ix Input
input Query
query ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> m (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> Text -> GVal (Run SourcePos (Writer Html) Html)
forall a b. a -> b -> a
const (GVal (Run SourcePos (Writer Html) Html)
 -> Text -> GVal (Run SourcePos (Writer Html) Html))
-> GVal (Run SourcePos (Writer Html) Html)
-> Text
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
-- | Run the given template with the given Bureaucromancy & Ginger data.
template' :: Monad m => String -> Form -> Int -> Input -> Query ->
        (Text -> GVal (Run SourcePos (Writer Html) Html)) ->
        m (Maybe (Either Query Text))
template' :: forall (m :: * -> *).
Monad m =>
FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' FilePath
name Form
form Int
ix Input
input Query
query Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt'
    | Just (Right Template SourcePos
tpl) <- IncludeResolver Maybe
-> FilePath -> Maybe (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
IncludeResolver m
-> FilePath -> m (Either ParserError (Template SourcePos))
parseGingerFile IncludeResolver Maybe
resolveSource FilePath
name =
        Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right (Text -> Either Query Text) -> Text -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Html -> Text
htmlSource (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$
            (GingerContext SourcePos (Writer Html) Html
 -> Template SourcePos -> Html)
-> Template SourcePos
-> GingerContext SourcePos (Writer Html) Html
-> Html
forall a b c. (a -> b -> c) -> b -> a -> c
flip GingerContext SourcePos (Writer Html) Html
-> Template SourcePos -> Html
forall p h.
(ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p,
 Monoid h) =>
GingerContext p (Writer h) h -> Template p -> h
runGinger Template SourcePos
tpl (GingerContext SourcePos (Writer Html) Html -> Html)
-> GingerContext SourcePos (Writer Html) Html -> Html
forall a b. (a -> b) -> a -> b
$ (Text -> GVal (Run SourcePos (Writer Html) Html))
-> GingerContext SourcePos (Writer Html) Html
forall p.
(Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContextHtml Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt
    | Just (Left ParserError
err) <- IncludeResolver Maybe
-> FilePath -> Maybe (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
IncludeResolver m
-> FilePath -> m (Either ParserError (Template SourcePos))
parseGingerFile IncludeResolver Maybe
resolveSource FilePath
name =
        Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right (Text -> Either Query Text) -> Text -> Either Query Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParserError -> FilePath
forall a. Show a => a -> FilePath
show ParserError
err
    | Bool
otherwise = Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right Text
"Unexpected error!"
  where
    ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
    ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt Text
"Q" = Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Monad m => Query -> GVal m
query2gval Query
query
    ctxt Text
"form" = Form -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Form -> GVal m
form2gval Form
form
    ctxt Text
"inputs" = [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal (Run SourcePos (Writer Html) Html)]
 -> GVal (Run SourcePos (Writer Html) Html))
-> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ ((Int, Input) -> GVal (Run SourcePos (Writer Html) Html))
-> [(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(Int, Input)
x -> FilePath
-> (Int, Input) -> Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int, Input)
x Query
query) ([(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)])
-> [(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$
        [Int] -> [Input] -> [(Int, Input)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0..] ([Input] -> [(Int, Input)]) -> [Input] -> [(Int, Input)]
forall a b. (a -> b) -> a -> b
$ Form -> [Input]
inputs Form
form
    ctxt Text
"input" = FilePath
-> (Int, Input) -> Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int
ix, Input
input) Query
query
    ctxt Text
"xURI" = Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Function m -> GVal m
fromFunction Function (Run SourcePos (Writer Html) Html)
forall {m :: * -> *} {a} {m :: * -> *} {m :: * -> *}.
Monad m =>
[(a, GVal m)] -> m (GVal m)
xURI
    ctxt Text
"_" = Value -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Value -> GVal (Run SourcePos (Writer Html) Html))
-> Value -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ FilePath -> Value
stringsJSON FilePath
language
    ctxt Text
x = Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt' Text
x
    xURI :: [(a, GVal m)] -> m (GVal m)
xURI [(a
_, GVal m
uri)] = let uri' :: FilePath
uri' = Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ GVal m -> Text
forall (m :: * -> *). GVal m -> Text
asText GVal m
uri in
        GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal(Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
escapeURIString Char -> Bool
isUnescapedInURIComponent FilePath
uri'
    xURI [(a, GVal m)]
_ = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$ () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
    language :: FilePath
language = Form -> FilePath
lang Form
form

-- | Lookup the given template from a compiled-in directory.
resolveSource :: FilePath -> Maybe (Maybe [Char])
resolveSource :: IncludeResolver Maybe
resolveSource (Char
'/':FilePath
path) = IncludeResolver Maybe
resolveSource FilePath
path
resolveSource FilePath
path = Maybe FilePath -> Maybe (Maybe FilePath)
forall a. a -> Maybe a
Just (Maybe FilePath -> Maybe (Maybe FilePath))
-> Maybe FilePath -> Maybe (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
utf8 (Maybe ByteString -> Maybe FilePath)
-> Maybe ByteString -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$
    (FilePath -> [(FilePath, ByteString)] -> Maybe ByteString)
-> [(FilePath, ByteString)] -> FilePath -> Maybe ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) (FilePath -> Maybe ByteString) -> FilePath -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
path

-- | Convert a query into Ginger's datamodel.
query2gval :: Monad m => Query -> GVal m
query2gval :: forall (m :: * -> *). Monad m => Query -> GVal m
query2gval Query
qs =
    ([Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [(ByteString -> Text
Txt.decodeUtf8 ByteString
k, ([ByteString] -> GVal m
forall (m :: * -> *) a. ToGVal m a => [a] -> GVal m
list1 [ByteString]
vs){ asFunction = Just $ gElem vs })
            | (ByteString
k, [ByteString]
vs) <- Query -> [(ByteString, [ByteString])]
forall k v. Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort Query
qs]) {
        asText = Txt.pack q,
        asHtml = unsafeRawHtml $ Txt.pack q
    }
  where
    q :: FilePath
q = Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)] -> FilePath
renderQueryString' [(ByteString -> FilePath
utf8 ByteString
k, ByteString -> FilePath
utf8 (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
v) | (ByteString
k, Maybe ByteString
v) <- Query
qs]
    gElem :: Monad m => [ByteString] -> Function m
    gElem :: forall (m :: * -> *). Monad m => [ByteString] -> Function m
gElem [ByteString]
xs [(Maybe Text
_, GVal m
x)] | Just ByteString
x' <- GVal m -> Maybe ByteString
forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
x = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal(Bool -> GVal m) -> Bool -> GVal m
forall a b. (a -> b) -> a -> b
$ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Prelude.elem ByteString
x' [ByteString]
xs
    gElem [ByteString]
_ [(Maybe Text, GVal m)]
_ = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$ () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()

-- | Convert a form to Ginger's datamodel.
form2gval :: Form -> GVal m
form2gval :: forall (m :: * -> *). Form -> GVal m
form2gval Form
form = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
    Text
"action"   Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id (Form -> URI
action Form
form) FilePath
"",
    Text
"enctype"  Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
enctype Form
form,
    Text
"method"   Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
method Form
form,
    Text
"validate" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Bool
validate Form
form,
    Text
"target"   Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
target Form
form,
    Text
"charset"  Text -> [Text] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> [Text]
acceptCharset Form
form,
    Text
"autocomplete"Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>Form -> Bool
autocomplete Form
form,
    Text
"name"     Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
formName Form
form,
    Text
"rel"      Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
rel Form
form
  ]

-- | Convert an input to Ginger's datamodel.
input2gval :: String -> (Int, Input) -> Query -> GVal m
input2gval :: forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int
ix, Input
input) Query
query = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
    Text
"index"       Text -> Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
ix,
    Text
"label"       Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
label Input
input,
    Text
"error"       Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FilePath -> Input -> FilePath
inputErrorMessage' FilePath
language (Input -> [(FilePath, FilePath)] -> Input
applyQuery Input
input
            [(ByteString -> FilePath
B8.unpack ByteString
k, ByteString -> FilePath
B8.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
v) | (ByteString
k, Maybe ByteString
v) <- Query
query]),
    Text
"description" Text -> Html -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Node -> Html
html (Input -> Node
description Input
input),
    Text
"inputType"   Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputType Input
input,
    Text
"dirName"     Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
dirname Input
input,
    Text
"name"        Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputName Input
input,
    Text
"value"       Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> if Input -> Text
inputType Input
input Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Text
"radio", Text
"checkbox"]
        then Input -> Text
value Input
input
        else Text -> [Text] -> Text
Txt.intercalate Text
", " [ByteString -> Text
Txt.decodeUtf8 ByteString
v | (ByteString
k, Just ByteString
v) <- Query
query,
            Text -> ByteString
Txt.encodeUtf8 (Input -> Text
inputName Input
input) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
k],
    Text
"autocomplete"Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputAutocomplete Input
input,
    Text
"autofocus"   Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
autofocus Input
input,
    Text
"checked"     Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Input -> Text
inputType Input
input Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Text
"radio", Text
"checkbox"] Bool -> Bool -> Bool
&&
        if Input -> Text
value Input
inputText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
        then Maybe (Maybe ByteString) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Maybe ByteString) -> Bool)
-> Maybe (Maybe ByteString) -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup (Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
inputName Input
input) Query
query
        else (Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
inputName Input
input,
            ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
value Input
input) (ByteString, Maybe ByteString) -> Query -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` Query
query),
    Text
"disabled"    Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
disabled Input
input,
    Text
"readonly"    Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
readonly Input
input,
    Text
"multiple"    Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
multiple Input
input,
    (Text
"form", [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
        Text
"action"  Text -> Maybe FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ((URI -> FilePath -> FilePath) -> FilePath -> URI -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id) FilePath
"" (URI -> FilePath) -> Maybe URI -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe URI
formAction Input
input),
        Text
"enctype" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formEnctype Input
input,
        Text
"method"  Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formMethod Input
input,
        Text
"validate"Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
formValidate Input
input,
        Text
"target"  Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formTarget Input
input
    ]),
    Text
"inputmode"   Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputMode Input
input,
    (Text
"list", [GVal m] -> GVal m
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal m] -> GVal m) -> [GVal m] -> GVal m
forall a b. (a -> b) -> a -> b
$ (OptionGroup -> GVal m) -> [OptionGroup] -> [GVal m]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ([ByteString] -> OptionGroup -> GVal m
forall (m :: * -> *). [ByteString] -> OptionGroup -> GVal m
optgroup2gval [ByteString
v |
            (ByteString
k, Just ByteString
v) <- Query
query, ByteString -> Text
Txt.decodeUtf8 ByteString
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Input -> Text
inputName Input
input])
        ([OptionGroup] -> [GVal m]) -> [OptionGroup] -> [GVal m]
forall a b. (a -> b) -> a -> b
$ Input -> [OptionGroup]
list Input
input),
    Text
"min"         Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> a
fst (Input -> (Maybe Text, Maybe Text)
range Input
input),
    Text
"max"         Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd (Input -> (Maybe Text, Maybe Text)
range Input
input),
    Text
"step"        Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
step Input
input,
    Text
"minlength"   Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> a
fst (Input -> (Maybe Int, Maybe Int)
lengthRange Input
input),
    Text
"maxLength"   Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Input -> (Maybe Int, Maybe Int)
lengthRange Input
input),
    Text
"required"    Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
required Input
input,
    Text
"placeholder" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
placeholder Input
input,
    Text
"title"       Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
title Input
input,
    Text
"size"        Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Int
size Input
input,
    Text
"accept"      Text -> [Text] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FileSelector -> [Text]
fileAccept (Input -> FileSelector
fileData Input
input),
    Text
"capture"     Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FileSelector -> Text
fileCapture (Input -> FileSelector
fileData Input
input),
    Text
"alt"         Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ImageData -> Maybe Text
imgAlt (Input -> ImageData
imageData Input
input),
    Text
"width"       Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> a
fst (ImageData -> (Maybe Int, Maybe Int)
imgSize (ImageData -> (Maybe Int, Maybe Int))
-> ImageData -> (Maybe Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input),
    Text
"height"      Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (ImageData -> (Maybe Int, Maybe Int)
imgSize (ImageData -> (Maybe Int, Maybe Int))
-> ImageData -> (Maybe Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input),
    Text
"src"         Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id (URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ ImageData -> Maybe URI
imgSrc (ImageData -> Maybe URI) -> ImageData -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input) FilePath
"",
    Text
"autocorrect" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Bool
autocorrect (Input -> TextArea
textArea Input
input),
    Text
"cols"        Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Int
size Input
input,
    Text
"rows"        Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Int
rows (Input -> TextArea
textArea Input
input),
    Text
"spellcheck"  Text -> Maybe Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Bool
spellcheck (Input -> TextArea
textArea Input
input),
    Text
"textwrap"    Text -> Maybe Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Bool
textwrap (Input -> TextArea
textArea Input
input)
  ]
-- | Convert an XML node to Ginger's datamodel.
html :: Node -> Html
html :: Node -> Html
html Node
node = Text -> Html
unsafeRawHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text
Txt.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> Text
renderText RenderSettings
forall a. Default a => a
def (
    Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) (Name -> Map Name Text -> [Node] -> Element
Element Name
"div" Map Name Text
forall k a. Map k a
M.empty [Node
node]) []
  )
-- | Convert an option group to Ginger's datamodel.
optgroup2gval :: [ByteString] -> OptionGroup -> GVal m
optgroup2gval :: forall (m :: * -> *). [ByteString] -> OptionGroup -> GVal m
optgroup2gval [ByteString]
query OptionGroup
optgroup = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
    Text
"label"    Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> OptionGroup -> Text
optsLabel OptionGroup
optgroup,
    Text
"disabled" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> OptionGroup -> Bool
optsDisabled OptionGroup
optgroup,
    (Text
"opts", [GVal m] -> GVal m
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal m] -> GVal m) -> [GVal m] -> GVal m
forall a b. (a -> b) -> a -> b
$ (Option -> GVal m) -> [Option] -> [GVal m]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ([ByteString] -> Option -> GVal m
forall (m :: * -> *). [ByteString] -> Option -> GVal m
opt2gval [ByteString]
query) ([Option] -> [GVal m]) -> [Option] -> [GVal m]
forall a b. (a -> b) -> a -> b
$ OptionGroup -> [Option]
subopts OptionGroup
optgroup)
  ]
-- | Convert an option to Ginger's datamodel.
opt2gval :: [ByteString] -> Option -> GVal m
opt2gval :: forall (m :: * -> *). [ByteString] -> Option -> GVal m
opt2gval [ByteString]
query Option
opt = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
    Text
"label"    Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Text
optLabel Option
opt,
    Text
"value"    Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Text
optValue Option
opt,
    Text
"selected" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Option -> Text
optValue Option
opt Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ByteString -> Text
Txt.decodeUtf8 [ByteString]
query),
    Text
"disabled" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Bool
optDisabled Option
opt
  ]

-- | A ginger list which in most uses looks like its initial value.
list1 :: ToGVal m a => [a] -> GVal m
list1 :: forall (m :: * -> *) a. ToGVal m a => [a] -> GVal m
list1 vs :: [a]
vs@(a
v:[a]
_) = (a -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
v) {
    asList = Just $ Prelude.map toGVal vs,
    V.length = Just $ Prelude.length vs
  }
list1 [] = (Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
True) { asList = Just [], V.length = Just 0 }
-- | Type-constrained conversion of a list to Ginger's datamodel,
-- serves to avoid type-inference issues.
list' :: [GVal m] -> GVal m
list' :: forall (m :: * -> *). [GVal m] -> GVal m
list' = [GVal m] -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal

-- | Aggregates values in a key-value list under their keys.
groupSort :: Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort :: forall k v. Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort [(k, Maybe v)]
q = [(k
k, [v
v | (k
k', Just v
v) <- [(k, Maybe v)]
q, k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k']) | k
k <- [k] -> [k]
forall a. Eq a => [a] -> [a]
nub ([k] -> [k]) -> [k] -> [k]
forall a b. (a -> b) -> a -> b
$ ((k, Maybe v) -> k) -> [(k, Maybe v)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (k, Maybe v) -> k
forall a b. (a, b) -> a
fst [(k, Maybe v)]
q]

-- | Convert from UTF-8 bytestring to a string.
utf8 :: ByteString -> String
utf8 :: ByteString -> FilePath
utf8 = Text -> FilePath
Txt.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Txt.decodeUtf8