{-#LANGUAGE FlexibleContexts #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE TupleSections #-}
{-#LANGUAGE TypeSynonymInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE ScopedTypeVariables #-}
module Text.Ginger.Run.FuncUtils
where
import Prelude ( (.), ($), (==), (/=)
, (>), (<), (>=), (<=)
, (+), (-), (*), (/), div, (**), (^)
, (||), (&&)
, (++)
, Show, show
, undefined, otherwise
, Maybe (..)
, Bool (..)
, Int, Integer, String
, fromIntegral, floor, round
, not
, show
, uncurry
, seq
, fst, snd
, maybe
, Either (..)
, id
)
import qualified Prelude
import Data.Maybe (fromMaybe, isJust)
import qualified Data.List as List
import Text.Ginger.AST
import Text.Ginger.Html
import Text.Ginger.GVal
import Text.Ginger.Run.Type
import Text.Printf
import Text.PrintfA
import Data.Scientific (formatScientific)
import Data.Text (Text)
import Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.ByteString.UTF8 as UTF8
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State
import Control.Applicative
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Data.Scientific (Scientific)
import Data.Scientific as Scientific
import Data.Default (def)
import Safe (readMay, lastDef, headMay)
import Network.HTTP.Types (urlEncode)
import Debug.Trace (trace)
import Data.Maybe (isNothing)
import Data.List (lookup, zipWith, unzip)
unaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)
unaryFunc :: forall (m :: * -> *) h p.
Monad m =>
(GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)
unaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f [] = do
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn forall a b. (a -> b) -> a -> b
$ forall p. Maybe Text -> Text -> RuntimeError p
ArgumentsError forall a. Maybe a
Nothing Text
"expected exactly one argument (zero given)"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
unaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f ((Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x):[]) =
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x)
unaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f ((Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x):[(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
_) = do
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn forall a b. (a -> b) -> a -> b
$ forall p. Maybe Text -> Text -> RuntimeError p
ArgumentsError forall a. Maybe a
Nothing Text
"expected exactly one argument (more given)"
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x)
binaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)
binaryFunc :: forall (m :: * -> *) h p.
Monad m =>
(GVal (Run p m h) -> GVal (Run p m h) -> GVal (Run p m h))
-> Function (Run p m h)
binaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f [] = do
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn forall a b. (a -> b) -> a -> b
$ forall p. Maybe Text -> Text -> RuntimeError p
ArgumentsError forall a. Maybe a
Nothing Text
"expected exactly two arguments (zero given)"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
binaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f ((Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
_:[]) = do
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn forall a b. (a -> b) -> a -> b
$ forall p. Maybe Text -> Text -> RuntimeError p
ArgumentsError forall a. Maybe a
Nothing Text
"expected exactly two arguments (one given)"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
binaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f ((Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x):(Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
y):[]) =
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
y)
binaryFunc GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f ((Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x):(Maybe Text
_, GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
y):[(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
_) = do
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn forall a b. (a -> b) -> a -> b
$ forall p. Maybe Text -> Text -> RuntimeError p
ArgumentsError forall a. Maybe a
Nothing Text
"expected exactly two arguments (more given)"
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
f GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
x GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
y)
ignoreArgNames :: ([a] -> b) -> ([(c, a)] -> b)
ignoreArgNames :: forall a b c. ([a] -> b) -> [(c, a)] -> b
ignoreArgNames [a] -> b
f [(c, a)]
args = [a] -> b
f (forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall a b. (a, b) -> b
snd [(c, a)]
args)
variadicNumericFunc :: Monad m => Scientific -> ([Scientific] -> Scientific) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))
variadicNumericFunc :: forall (m :: * -> *) p h.
Monad m =>
Scientific
-> ([Scientific] -> Scientific)
-> [(Maybe Text, GVal (Run p m h))]
-> Run p m h (GVal (Run p m h))
variadicNumericFunc Scientific
zero [Scientific] -> Scientific
f [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Scientific] -> Scientific
f forall a b. (a -> b) -> a -> b
$ [Scientific]
args'
where
args' :: [Scientific]
args' :: [Scientific]
args' = forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall a. a -> Maybe a -> a
fromMaybe Scientific
zero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args
unaryNumericFunc :: Monad m => Scientific -> (Scientific -> Scientific) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))
unaryNumericFunc :: forall (m :: * -> *) p h.
Monad m =>
Scientific
-> (Scientific -> Scientific)
-> [(Maybe Text, GVal (Run p m h))]
-> Run p m h (GVal (Run p m h))
unaryNumericFunc Scientific
zero Scientific -> Scientific
f [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Scientific
f forall a b. (a -> b) -> a -> b
$ Scientific
args'
where
args' :: Scientific
args' :: Scientific
args' = case [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args of
[] -> Scientific
0
((Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
arg:[(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
_) -> forall a. a -> Maybe a -> a
fromMaybe Scientific
zero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
arg
variadicStringFunc :: Monad m => ([Text] -> Text) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))
variadicStringFunc :: forall (m :: * -> *) p h.
Monad m =>
([Text] -> Text)
-> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))
variadicStringFunc [Text] -> Text
f [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
f forall a b. (a -> b) -> a -> b
$ [Text]
args'
where
args' :: [Text]
args' :: [Text]
args' = forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall (m :: * -> *). GVal m -> Text
asText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Maybe Text,
GVal
(ExceptT
(RuntimeError p)
(StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))]
args
extractArgs :: [Text] -> [(Maybe Text, a)] -> (HashMap Text a, [a], HashMap Text a, [Text])
[Text]
argNames [(Maybe Text, a)]
args =
let ([(Text, a)]
matchedPositional, [Text]
argNames', [(Maybe Text, a)]
args') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchPositionalArgs [Text]
argNames [(Maybe Text, a)]
args
([(Text, a)]
matchedKeyword, [Text]
argNames'', [(Maybe Text, a)]
args'') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs [Text]
argNames' [(Maybe Text, a)]
args'
unmatchedPositional :: [a]
unmatchedPositional = [ a
a | (Maybe Text
Nothing, a
a) <- [(Maybe Text, a)]
args'' ]
unmatchedKeyword :: HashMap Text a
unmatchedKeyword = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
k, a
v) | (Just Text
k, a
v) <- [(Maybe Text, a)]
args'' ]
in ( forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, a)]
matchedPositional forall a. [a] -> [a] -> [a]
++ [(Text, a)]
matchedKeyword)
, [a]
unmatchedPositional
, HashMap Text a
unmatchedKeyword
, [Text]
argNames''
)
where
matchPositionalArgs :: [Text] -> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchPositionalArgs :: forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchPositionalArgs [] [(Maybe Text, a)]
args = ([], [], [(Maybe Text, a)]
args)
matchPositionalArgs [Text]
names [] = ([], [Text]
names, [])
matchPositionalArgs names :: [Text]
names@(Text
n:[Text]
ns) allArgs :: [(Maybe Text, a)]
allArgs@((Maybe Text
anm, a
arg):[(Maybe Text, a)]
args)
| forall a. a -> Maybe a
Just Text
n forall a. Eq a => a -> a -> Bool
== Maybe Text
anm Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing Maybe Text
anm =
let ([(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchPositionalArgs [Text]
ns [(Maybe Text, a)]
args
in ((Text
n, a
arg)forall a. a -> [a] -> [a]
:[(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args')
| Bool
otherwise = ([], [Text]
names, [(Maybe Text, a)]
allArgs)
matchKeywordArgs :: [Text] -> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs :: forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs [] [(Maybe Text, a)]
args = ([], [], [(Maybe Text, a)]
args)
matchKeywordArgs [Text]
names allArgs :: [(Maybe Text, a)]
allArgs@((Maybe Text
Nothing, a
arg):[(Maybe Text, a)]
args) =
let ([(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs [Text]
names [(Maybe Text, a)]
args
in ([(Text, a)]
matched, [Text]
ns', (forall a. Maybe a
Nothing, a
arg)forall a. a -> [a] -> [a]
:[(Maybe Text, a)]
args')
matchKeywordArgs names :: [Text]
names@(Text
n:[Text]
ns) [(Maybe Text, a)]
args =
case (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. a -> Maybe a
Just Text
n) [(Maybe Text, a)]
args) of
Maybe a
Nothing ->
let ([(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs [Text]
ns [(Maybe Text, a)]
args
in ([(Text, a)]
matched, Text
nforall a. a -> [a] -> [a]
:[Text]
ns', [(Maybe Text, a)]
args')
Just a
v ->
let args' :: [(Maybe Text, a)]
args' = [ (Maybe Text
k,a
v) | (Maybe Text
k,a
v) <- [(Maybe Text, a)]
args, Maybe Text
k forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Text
n ]
([(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args'') = forall a.
[Text]
-> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)])
matchKeywordArgs [Text]
ns [(Maybe Text, a)]
args'
in ((Text
n,a
v)forall a. a -> [a] -> [a]
:[(Text, a)]
matched, [Text]
ns', [(Maybe Text, a)]
args'')
extractArgsT :: ([Maybe a] -> b) -> [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) b
[Maybe a] -> b
f [Text]
argNames [(Maybe Text, a)]
args =
let (HashMap Text a
matchedMap, [a]
freeArgs, HashMap Text a
freeKwargs, [Text]
unmatched) = forall a.
[Text]
-> [(Maybe Text, a)]
-> (HashMap Text a, [a], HashMap Text a, [Text])
extractArgs [Text]
argNames [(Maybe Text, a)]
args
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [a]
freeArgs Bool -> Bool -> Bool
&& forall k v. HashMap k v -> Bool
HashMap.null HashMap Text a
freeKwargs
then forall a b. b -> Either a b
Right ([Maybe a] -> b
f forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
name -> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text a
matchedMap) [Text]
argNames)
else forall a b. a -> Either a b
Left ([a]
freeArgs, HashMap Text a
freeKwargs, [Text]
unmatched)
extractArgsL :: [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [Maybe a]
= forall a b.
([Maybe a] -> b)
-> [Text]
-> [(Maybe Text, a)]
-> Either ([a], HashMap Text a, [Text]) b
extractArgsT forall a. a -> a
id
extractArgsDefL :: [(Text, a)] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [a]
[(Text, a)]
argSpec [(Maybe Text, a)]
args =
let ([Text]
names, [a]
defs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, a)]
argSpec
in forall a. [a] -> [Maybe a] -> [a]
injectDefaults [a]
defs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
[Text]
-> [(Maybe Text, a)]
-> Either ([a], HashMap Text a, [Text]) [Maybe a]
extractArgsL [Text]
names [(Maybe Text, a)]
args
injectDefaults :: [a] -> [Maybe a] -> [a]
injectDefaults :: forall a. [a] -> [Maybe a] -> [a]
injectDefaults = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> Maybe a -> a
fromMaybe