{-# LANGUAGE OverloadedStrings #-}
-- | Renders forms to an HTML menu, for the sake of highly-constrained browser engines.
-- Like those dealing with TV remotes.
module Text.HTML.Form.WebApp (renderPage, Form(..), Query) where

import Data.ByteString as BS
import Data.ByteString.Char8 as B8
import Data.Text as Txt
import Data.Text.Encoding as Txt
import Data.List as L
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Network.URI (unEscapeString)
import System.IO (readFile')
import System.FilePath ((</>), normalise)
import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist,
        doesDirectoryExist, listDirectory, getHomeDirectory)

import Text.HTML.Form (Form(..), Input(..))
import Text.HTML.Form.WebApp.Ginger (template, template', resolveSource, list')
import Text.HTML.Form.Query (renderQueryString, renderQuery', applyQuery')
import Text.HTML.Form.Validate (isFormValid')
import Text.HTML.Form.WebApp.Ginger.Hourglass (timeData, modifyTime', timeParseOrNow,
        gSeqTo, gPad2)
import Text.HTML.Form.WebApp.Ginger.TZ (tzdata, continents)

import Text.Ginger.GVal as V (GVal(..), ToGVal(..), orderedDict, (~>), fromFunction, list)
import Text.Ginger.Html (html)
import Data.Hourglass (Elapsed(..), Seconds(..), timeGetElapsed, localTimeToGlobal)
import Text.HTML.Form.Colours (tailwindColours)

-- | The query string manipulated by this serverside webapp.
type Query = [(ByteString, Maybe ByteString)]
-- | Converts URI path & query to rendered hyper-linked HTML representing menus
-- for selecting values to upload to the server as prescribed by the given form.
-- These values are returned to caller on the Left-branch.
renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
renderPage Form
form (Text
n:[Text]
path) Query
query
    | Just Int
ix <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Txt.unpack Text
n, Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Input] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (Form -> [Input]
inputs Form
form) =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix (Form -> [Input]
inputs Form
form [Input] -> Int -> Input
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix) [Text]
path Query
query
renderPage Form
form [] Query
_ = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ [Text] -> Text
Txt.concat [
    Text
"<a href='/0/?", [Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Form -> [Char]
renderQueryString Form
form, Text
"'>Start!</a>"]
renderPage Form
_ [Text]
_ Query
_ = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Query Text)
forall a. Maybe a
Nothing

-- | Is this input type amongst the date-time family?
isCalType :: Text -> Bool
isCalType :: Text -> Bool
isCalType = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.elem [Text
"date", Text
"datetime-local", Text
"datetime", Text
"month", Text
"time", Text
"week"]
-- | Render an input to the corresponding HTML, or form data to submit.
renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
    IO (Maybe (Either Query Text))
renderInput :: Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
""] Query
qs = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
name } [Text
"year", Text
p] Query
qs
    | Text -> Bool
isCalType Text
ty,
      Just [Char]
t <- Text -> [Char] -> Maybe [Char]
modifyTime' ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"year/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
p) ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
name Query
qs = do
        LocalTime DateTime
t' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow [Char]
t
        [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"cal/year-numpad.html" Form
form Int
ix Input
input (Text -> Text -> Query -> Query
set Text
name ([Char] -> Text
Txt.pack [Char]
t) Query
qs) ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
            \Text
prop -> case Text
prop of
                Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
t'
                Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
name } [Text
"zone", Text
p] Query
qs
    | Text -> Bool
isCalType Text
ty = do
        LocalTime DateTime
t <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow ([Char] -> IO (LocalTime DateTime))
-> [Char] -> IO (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
name Query
qs
        let Elapsed (Seconds Int64
t') = DateTime -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed (DateTime -> Elapsed) -> DateTime -> Elapsed
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. Time t => LocalTime t -> t
localTimeToGlobal LocalTime DateTime
t
        [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"cal/timezone.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
prop -> case Text
prop of
            Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
t
            Text
"zones" -> Int64 -> [Char] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Int64 -> [Char] -> GVal m
tzdata Int64
t' ([Char] -> GVal (Run SourcePos (Writer Html) Html))
-> [Char] -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Txt.unpack Text
p
            Text
"continents" -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). GVal m
continents
            Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { multiple :: Input -> Bool
multiple = Bool
True } [Text
p] Query
qs
    | Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p,
            (Text -> ByteString
utf8 (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
$ [Char] -> ByteString
utf8' [Char]
v') (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
qs =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Query -> Query
unset (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
    | Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
        (Text -> ByteString
utf8 (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
$ [Char] -> ByteString
utf8' ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:Query
qs
renderInput Form
form Int
ix Input
input [Text
p] Query
qs
    | Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
    | Char
':':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
            ([Char] -> Text
Txt.pack (Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v')) Query
qs
    | [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p, v' :: [Char]
v'@(Char
_:[Char]
_) <- Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
            ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
Prelude.init [Char]
v') Query
qs
    | [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] Query
qs
    | Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
x <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double,
            Just Double
y <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Double) -> [Char] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y) Query
qs
    | Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
_ <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack [Char]
x') Query
qs
renderInput Form
form Int
ix Input
input [Text
x, Text
p] Query
qs
    | Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
    | Char
':':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
            ([Char] -> Text
Txt.pack (Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v')) Query
qs
    | [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p, v' :: [Char]
v'@(Char
_:[Char]
_) <- Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
            ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
Prelude.init [Char]
v') Query
qs
    | [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] Query
qs
    | Char
'+':[Char]
z' <- Text -> [Char]
Txt.unpack Text
p, Just Double
z <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
z' :: Maybe Double,
            Just Double
y <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Double) -> [Char] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y) Query
qs
    | Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
_ <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double =
        Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack [Char]
x') Query
qs
renderInput Form
form Int
ix input :: Input
input@Input {inputType :: Input -> Text
inputType=Text
"checkbox", inputName :: Input -> Text
inputName=Text
k', value :: Input -> Text
value=Text
v'} [] Query
qs
    | (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v') (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
qs =
        [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
unset Text
k' Text
v' Query
qs
    | Text
v' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"", (Text -> ByteString
utf8 Text
k', Maybe ByteString
forall a. Maybe a
Nothing) (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
qs =
        [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input [
            (ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
v) <- Query
qs, Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
utf8 Text
k' Bool -> Bool -> Bool
&& Maybe ByteString
v Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
forall a. Maybe a
Nothing)]
    | Bool
otherwise =
        [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:Query
qs
renderInput Form
form Int
ix input :: Input
input@Input {inputType :: Input -> Text
inputType=Text
"radio", inputName :: Input -> Text
inputName=Text
k', value :: Input -> Text
value=Text
v'} [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set Text
k' Text
v' Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"<select>" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"select.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"submit" } [] Query
qs =
    [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"submit.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
        Text
"isFormValid" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Bool -> GVal (Run SourcePos (Writer Html) Html))
-> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ Input -> Bool
formValidate Input
input Bool -> Bool -> Bool
&&
                Form -> Bool
isFormValid' (Form -> [([Char], [Char])] -> Form
applyQuery' Form
form ([([Char], [Char])] -> Form) -> [([Char], [Char])] -> Form
forall a b. (a -> b) -> a -> b
$ Query -> [([Char], [Char])]
strQuery Query
qs)
        Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
_ Int
_ input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"submit" } [Text
"_"] Query
qs =
    Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ Query -> Either Query Text
forall a b. a -> Either a b
Left (Query -> Either Query Text) -> Query -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) (Input -> Text
value Input
input) Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"image" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"image-button.html" Form
form Int
ix Input
input Query
qs
renderInput Form
_ Int
_ input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"image" } [Text
"_"] Query
qs =
    Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ Query -> Either Query Text
forall a b. a -> Either a b
Left (Query -> Either Query Text) -> Query -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) (Input -> Text
value Input
input) Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"reset" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"reset.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"reset" } [Text
"_"] Query
_ =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"reset.html" Form
form Int
ix Input
input
        [([Char] -> ByteString
utf8' [Char]
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
utf8' [Char]
v) | ([Char]
k, [Char]
v) <- Form -> [([Char], [Char])]
renderQuery' Form
form]
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"file" } [Text]
path Query
qs = do
    [Char]
home <- IO [Char]
getHomeDirectory
    let filepath :: [Char]
filepath = [Char] -> [Char]
normalise ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl [Char] -> [Char] -> [Char]
(</>) [Char]
home ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
L.map Text -> [Char]
Txt.unpack [Text]
path
    [[Char]]
subfiles <- [Char] -> IO [[Char]]
listDirectory [Char]
filepath
    ([[Char]]
dirs, [[Char]]
files) <- ([Char] -> IO Bool) -> [[Char]] -> IO ([[Char]], [[Char]])
forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM ([Char] -> [Char] -> IO Bool
doesDirectoryExist' [Char]
filepath) [[Char]]
subfiles
    [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"files.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
        Text
"path" -> ([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
$([[Char]] -> GVal (Run SourcePos (Writer Html) Html))
-> [[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [[Char]] -> GVal m
buildBreadcrumb([[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)])
-> [[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$[[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
L.inits([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$(Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
L.map Text -> [Char]
Txt.unpack [Text]
path) {
            asText = Txt.pack filepath,
            asHtml = html $ Txt.pack filepath
          }
        Text
"files" -> [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [[Char]]
files
        Text
"dirs" -> [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [[Char]]
dirs
        Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
  where
    buildBreadcrumb :: [String] -> GVal m
    buildBreadcrumb :: forall (m :: * -> *). [[Char]] -> GVal m
buildBreadcrumb [] = Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
    buildBreadcrumb [[Char]]
path' = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
        Text
"name" Text -> [Char] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
L.last [[Char]]
path',
        Text
"link" Text -> [Char] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"/" [[Char]]
path')
      ]
    doesDirectoryExist' :: [Char] -> [Char] -> IO Bool
doesDirectoryExist' [Char]
parent [Char]
file = [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
parent [Char] -> [Char] -> [Char]
</> [Char]
file
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"tel" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"tel.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"number" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"number.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"range" } [] Query
qs =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"number.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
n } [Text
op] Query
qs
    | Text
"week" <- Text
ty, Text
"+date" <- Text
op = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
"+date7"] Query
qs
    | Text
"week" <- Text
ty, Text
"-date" <- Text
op = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
"-date7"] Query
qs
    | Text -> Bool
isCalType Text
ty, Just [Char]
v <- Text -> [Char] -> Maybe [Char]
modifyTime' Text
op ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
n Query
qs = do
        -- TODO: Support other calendars
        LocalTime DateTime
v' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow [Char]
v
        [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"gregorian.html" Form
form Int
ix Input
input (Text -> Text -> Query -> Query
set Text
n ([Char] -> Text
Txt.pack [Char]
v) Query
qs) ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
            \Text
x -> case Text
x of
                Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
v'
                Text
"seqTo" -> 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)
 -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     (GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
 -> ExceptT
      (RuntimeError SourcePos)
      (StateT
         (RunState SourcePos (Writer Html) Html)
         (ReaderT
            (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
      (GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
    -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gSeqTo
                Text
"pad2" -> 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)
 -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     (GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
 -> ExceptT
      (RuntimeError SourcePos)
      (StateT
         (RunState SourcePos (Writer Html) Html)
         (ReaderT
            (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
      (GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
    -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gPad2
                Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
    | Text -> Bool
isCalType Text
ty = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Query Text)
forall a. Maybe a
Nothing
renderInput Form
f Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
n } [] Query
qs | Text -> Bool
isCalType Text
ty = do
    LocalTime DateTime
v' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow ([Char] -> IO (LocalTime DateTime))
-> [Char] -> IO (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
n Query
qs
    [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"gregorian.html" Form
f Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of -- TODO: Ditto
        Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
v'
        Text
"seqTo" -> 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)
 -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     (GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
 -> ExceptT
      (RuntimeError SourcePos)
      (StateT
         (RunState SourcePos (Writer Html) Html)
         (ReaderT
            (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
      (GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
    -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gSeqTo
        Text
"pad2" -> 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)
 -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     (GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
     (RuntimeError SourcePos)
     (StateT
        (RunState SourcePos (Writer Html) Html)
        (ReaderT
           (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
 -> ExceptT
      (RuntimeError SourcePos)
      (StateT
         (RunState SourcePos (Writer Html) Html)
         (ReaderT
            (GingerContext SourcePos (Writer Html) Html) (Writer Html)))
      (GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
    -> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gPad2
        Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"color" } [] Query
qs =
    [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"color.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
        Text
"colours" -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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
$ (([Char], [(Int, [Char])])
 -> GVal (Run SourcePos (Writer Html) Html))
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map ([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal ([([Char], [(Int, [Char])])]
 -> [GVal (Run SourcePos (Writer Html) Html)])
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [(Int, [Char])])]
tailwindColours ([Char] -> [([Char], [(Int, [Char])])])
-> [Char] -> [([Char], [(Int, [Char])])]
forall a b. (a -> b) -> a -> b
$ Form -> [Char]
lang Form
form
        Text
"shades" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
        Text
"subfolder" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
        Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"color" } [Text
c, Text
""] Query
qs =
    [Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"color.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
 -> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
        Text
"colours" -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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
$ (([Char], [(Int, [Char])])
 -> GVal (Run SourcePos (Writer Html) Html))
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map ([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal ([([Char], [(Int, [Char])])]
 -> [GVal (Run SourcePos (Writer Html) Html)])
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [(Int, [Char])])]
tailwindColours [Char]
l
        Text
"shades" -> case Text -> [Char]
Txt.unpack Text
c [Char] -> [([Char], [(Int, [Char])])] -> Maybe [(Int, [Char])]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [Char] -> [([Char], [(Int, [Char])])]
tailwindColours [Char]
l of
            Just [(Int, [Char])]
shades -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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, [Char]) -> GVal (Run SourcePos (Writer Html) Html))
-> [(Int, [Char])] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int, [Char]) -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 a2.
(ToGVal m a1, ToGVal m a2) =>
(a1, a2) -> GVal m
shadeGVal [(Int, [Char])]
shades
            Maybe [(Int, [Char])]
Nothing -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
        Text
"subfolder" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
True
        Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
 where l :: [Char]
l = Form -> [Char]
lang Form
form
renderInput Form
form Int
ix Input
input [Text
keyboard] Query
qs =
    Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs | Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path =
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
path Form
form Int
ix Input
input Query
qs
  where path :: [Char]
path = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs = do
    [Char]
configpath <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"bureaucromancy"
    Bool
exists <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
configpath [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
    [Char]
namespace <- if Bool
exists then [Char] -> IO [Char]
readFile' ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
configpath [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
        else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"latin1"
    let path :: [Char]
path = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
namespace [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
    let path2 :: [Char]
path2 = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
namespace [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
    let keyboard' :: [Char]
keyboard'
            | Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path = [Char]
path
            | Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path2 = [Char]
path2
            | Bool
otherwise = [Char]
"keyboards/latin1.html"
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
keyboard' Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix Input
input [] Query
qs = do
    [Char]
path <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"bureaucromancy"
    Bool
exists <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
path [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
    [Char]
keyboard <- if Bool
exists then [Char] -> IO [Char]
readFile' ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
path [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
        else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"latin1"
    let keyboard' :: [Char]
keyboard'
            | Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource ([Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html")
                = [Char]
keyboard
            | Bool
otherwise = [Char]
"latin1"
    [Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template ([Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
keyboard' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html") Form
form Int
ix Input
input Query
qs
renderInput Form
_ Int
_ Input
input [Text]
_ Query
_ =
    Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ [Text] -> Text
Txt.concat [Text
"Unknown input type: ", Input -> Text
inputType Input
input]

-- | Coerce Colour Pallet data into dynamically-typed Ginger data.
colourGVal :: (ToGVal m a1, ToGVal m b, Eq a2, Num a2) => (a1, [(a2, b)]) -> GVal m
colourGVal :: forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal (a1
key, [(a2, b)]
hues) = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [Text
"label"Text -> a1 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a1
key, Text
"value"Text -> Maybe b -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a2 -> [(a2, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a2
500 [(a2, b)]
hues]
shadeGVal :: (ToGVal m a1, ToGVal m a2) => (a1, a2) -> GVal m
shadeGVal :: forall (m :: * -> *) a1 a2.
(ToGVal m a1, ToGVal m a2) =>
(a1, a2) -> GVal m
shadeGVal (a1
key, a2
val) = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [Text
"label"Text -> a1 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a1
key, Text
"value"Text -> a2 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a2
val]

-- | Convert Text to UTF8 ByteString data.
utf8 :: Text -> ByteString
utf8 :: Text -> ByteString
utf8 = Text -> ByteString
Txt.encodeUtf8
-- | Convert String to UTF8 ByteString data.
utf8' :: String -> ByteString
utf8' :: [Char] -> ByteString
utf8' = Text -> ByteString
utf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Txt.pack
-- | Set the given key in the query to the given value.
set :: Text -> Text -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
set :: Text -> Text -> Query -> Query
set Text
"" Text
_ Query
qs = Query
qs -- Mostly for buttons!
set Text
k' Text
v' Query
qs = (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:[(ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
_) <- Query
qs, ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> ByteString
utf8 Text
k']
-- | Remove given key from the query.
unset :: Text -> Text -> [(ByteString, Maybe ByteString)]
    -> [(ByteString, Maybe ByteString)]
unset :: Text -> Text -> Query -> Query
unset Text
k' Text
v' Query
qs = [(ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
v) <- Query
qs, Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
utf8 Text
k' Bool -> Bool -> Bool
&& Maybe ByteString
v Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
utf8 Text
v'))]
-- | Retrieve the value corresponding to the given key in the query.
get :: Text -> [(ByteString, Maybe ByteString)] -> String
get :: Text -> Query -> [Char]
get Text
k' Query
qs
    | Just (Just ByteString
ret) <- Text -> ByteString
utf8 Text
k' ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Query
qs =
        Text -> [Char]
Txt.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Txt.decodeUtf8 ByteString
ret
    | Bool
otherwise = [Char]
""
-- | Convert the query data to string-pairs, for use in Query submodule.
strQuery :: [(ByteString, Maybe ByteString)] -> [(String, String)]
strQuery :: Query -> [([Char], [Char])]
strQuery Query
qs = [(ByteString -> [Char]
B8.unpack ByteString
k, ByteString -> [Char]
B8.unpack (ByteString -> [Char]) -> ByteString -> [Char]
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]

-- | Monadically takes a predicate and a list, and returns the pair of lists
-- of elements which do and do not satisfy the predicate, respectively.
partitionM :: Monad f => (a -> f Bool) -> [a] -> f ([a], [a])
partitionM :: forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM a -> f Bool
_ [] = ([a], [a]) -> f ([a], [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
partitionM a -> f Bool
f (a
x:[a]
xs) = do
    Bool
res <- a -> f Bool
f a
x
    ([a]
as,[a]
bs) <- (a -> f Bool) -> [a] -> f ([a], [a])
forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM a -> f Bool
f [a]
xs
    ([a], [a]) -> f ([a], [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a
x | Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
as, [a
x | Bool -> Bool
not Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
bs)