{-#LANGUAGE CPP #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE RankNTypes #-}

-- | GVal is a generic unitype value, representing the kind of values that
-- Ginger can understand.
--
-- Most of the types in this module are parametrized over an 'm' type, which
-- is the host monad for template execution, as passed to 'runGingerT'. For
-- most kinds of values, 'm' is transparent, and in many cases a 'ToGVal'
-- instance can be written that works for all possible 'm'; the reason we need
-- to parametrize the values themselves over the carrier monad is because we
-- want to support impure functions, which requires access to the underlying
-- carrier monad (e.g. 'IO').
module Text.Ginger.GVal
where

import Prelude ( (.), ($), (==), (/=)
               , (++), (+), (-), (*), (/), div
               , (=<<), (>>=), return
               , (||), (&&)
               , undefined, otherwise, id, const
               , fmap
               , Maybe (..)
               , Bool (..)
               , Either (..)
               , Char
               , Int
               , Integer
               , Double
               , Show, show
               , Integral
               , fromIntegral, floor
               , not
               , fst, snd
               , Monad
               , Functor
               )
import Control.Monad.Fail (MonadFail)
import qualified Prelude
import Data.Maybe ( fromMaybe, catMaybes, isJust, mapMaybe )
import Data.Text (Text)
import Data.String (IsString, fromString)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.List as List
import Safe (readMay, atMay)
import Data.Monoid
import Data.Scientific ( Scientific
                       , floatingOrInteger
                       , toBoundedInteger
                       , toRealFloat
                       , scientific
                       , coefficient
                       , base10Exponent
                       )
import Data.Fixed (Fixed (..), Pico)
import Control.Applicative
import qualified Data.Aeson as JSON
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as AKM
#endif
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Vector as Vector
import Control.Monad ((<=<), forM, mapM)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Default (Default, def)
import Text.Printf
import Debug.Trace (trace)
import Data.Time ( Day (..)
                 , defaultTimeLocale
                 , toModifiedJulianDay
                 , formatTime
                 , toGregorian
                 , fromGregorian
                 , LocalTime (..)
                 , ZonedTime (..)
                 , TimeOfDay (..)
                 , TimeZone (..)
                 , TimeLocale (..)
                 )
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Text.Lazy.Encoding as LText

import Text.Ginger.Html

-- * The Ginger Value type
--
-- | A variant type designed as the unitype for the template language. Any
-- value referenced in a template, returned from within a template, or used
-- in a template context, will be a 'GVal'.
-- @m@, in most cases, should be a 'Monad'.
--
-- Some laws apply here, most notably:
--
-- - when 'isNull' is 'True', then all of 'asFunction', 'asText', 'asNumber',
--   'asHtml', 'asList', 'asDictItems', and 'length' should produce 'Nothing'
-- - when 'isNull' is 'True', then 'asBoolean' should produce 'False'
-- - when 'asNumber' is not 'Nothing', then 'asBoolean' should only return
--   'False' for exactly zero
-- - 'Nothing'-ness of 'length' should match one or both of 'asList' / 'asDictItems'
data GVal m =
    GVal
        { forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList :: Maybe [GVal m] -- ^ Convert value to list, if possible
        , forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems :: Maybe [(Text, GVal m)] -- ^ Convert value to association list ("dictionary"), if possible
        , forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup :: Maybe (Text -> Maybe (GVal m)) -- ^ Convert value to a lookup function
        , forall (m :: * -> *). GVal m -> Html
asHtml :: Html -- ^ Render value as HTML
        , forall (m :: * -> *). GVal m -> Text
asText :: Text -- ^ Render value as plain-text
        , forall (m :: * -> *). GVal m -> Bool
asBoolean :: Bool -- ^ Get value's truthiness
        , forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber :: Maybe Scientific -- ^ Convert value to a number, if possible
        , forall (m :: * -> *). GVal m -> Maybe (Function m)
asFunction :: Maybe (Function m) -- ^ Access value as a callable function, if it is one
        , forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes :: Maybe ByteString -- ^ Access as raw bytes
        , forall (m :: * -> *). GVal m -> Maybe Int
length :: Maybe Int -- ^ Get length of value, if it is a collection (list/dict)
        , forall (m :: * -> *). GVal m -> Bool
isNull :: Bool -- ^ Check if the value is null
        , forall (m :: * -> *). GVal m -> Maybe Value
asJSON :: Maybe JSON.Value -- ^ Provide a custom JSON representation of the value
        }

gappend :: GVal m -> GVal m -> GVal m
gappend :: forall (m :: * -> *). GVal m -> GVal m -> GVal m
gappend GVal m
a GVal m
b =
  GVal
    { asList :: Maybe [GVal m]
asList = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
b
    , asDictItems :: Maybe [(Text, GVal m)]
asDictItems = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
b
    , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = do
        Text -> Maybe (GVal m)
lookupA <- forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup GVal m
a
        Text -> Maybe (GVal m)
lookupB <- forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup GVal m
b
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Text
k -> Text -> Maybe (GVal m)
lookupA Text
k forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe (GVal m)
lookupB Text
k
    , asHtml :: Html
asHtml = forall (m :: * -> *). GVal m -> Html
asHtml GVal m
a forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). GVal m -> Html
asHtml GVal m
b
    , asText :: Text
asText = forall (m :: * -> *). GVal m -> Text
asText GVal m
a forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). GVal m -> Text
asText GVal m
b
    , asBytes :: Maybe ByteString
asBytes = forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
a forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
b
    , asBoolean :: Bool
asBoolean = (forall (m :: * -> *). GVal m -> Bool
asBoolean GVal m
a Bool -> Bool -> Bool
|| forall (m :: * -> *). GVal m -> Bool
asBoolean GVal m
b) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (m :: * -> *). GVal m -> Bool
isNull GVal m
a Bool -> Bool -> Bool
|| forall (m :: * -> *). GVal m -> Bool
isNull GVal m
b)
    , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). GVal m -> Text
asText GVal m
a forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). GVal m -> Text
asText GVal m
b)
    , asFunction :: Maybe (Function m)
asFunction = forall a. Maybe a
Nothing
    , isNull :: Bool
isNull = forall (m :: * -> *). GVal m -> Bool
isNull GVal m
a Bool -> Bool -> Bool
|| forall (m :: * -> *). GVal m -> Bool
isNull GVal m
b
    , asJSON :: Maybe Value
asJSON = case (forall a. ToJSON a => a -> Value
JSON.toJSON GVal m
a, forall a. ToJSON a => a -> Value
JSON.toJSON GVal m
b) of
        (JSON.Array Array
x, JSON.Array Array
y) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Array -> Value
JSON.Array (Array
x forall a. Semigroup a => a -> a -> a
<> Array
y)
        (JSON.Object Object
x, JSON.Object Object
y) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Object -> Value
JSON.Object (Object
x forall a. Semigroup a => a -> a -> a
<> Object
y)
        (JSON.String Text
x, JSON.String Text
y) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Value
JSON.String (Text
x forall a. Semigroup a => a -> a -> a
<> Text
y)
        (Value
JSON.Null, Value
b) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Value
b
        (Value
a, Value
JSON.Null) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Value
a
        (Value, Value)
_ -> forall a. Maybe a
Nothing -- If JSON tags mismatch, use default toJSON impl
    , length :: Maybe Int
length = forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe Int
length GVal m
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). GVal m -> Maybe Int
length GVal m
b
    }

-- | Marshal a GVal between carrier monads.
-- This will lose 'asFunction' information, because functions cannot be
-- transferred to other carrier monads, but it will keep all other data
-- structures intact.
marshalGVal :: GVal m -> GVal n
marshalGVal :: forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal m
g =
    GVal
        { asList :: Maybe [GVal n]
asList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g
        , asDictItems :: Maybe [(Text, GVal n)]
asDictItems = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(Text, GVal m)]
items -> [(Text
k, forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal GVal m
v) | (Text
k, GVal m
v) <- [(Text, GVal m)]
items]) (forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
g)
        , asLookup :: Maybe (Text -> Maybe (GVal n))
asLookup = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) (n :: * -> *). GVal m -> GVal n
marshalGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup GVal m
g)
        , asHtml :: Html
asHtml = forall (m :: * -> *). GVal m -> Html
asHtml GVal m
g
        , asText :: Text
asText = forall (m :: * -> *). GVal m -> Text
asText GVal m
g
        , asBytes :: Maybe ByteString
asBytes = forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
g
        , asBoolean :: Bool
asBoolean = forall (m :: * -> *). GVal m -> Bool
asBoolean GVal m
g
        , asNumber :: Maybe Scientific
asNumber = forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
g
        , asFunction :: Maybe (Function n)
asFunction = forall a. Maybe a
Nothing
        , isNull :: Bool
isNull = forall (m :: * -> *). GVal m -> Bool
isNull GVal m
g
        , length :: Maybe Int
length = forall (m :: * -> *). GVal m -> Maybe Int
length GVal m
g
        , asJSON :: Maybe Value
asJSON = forall (m :: * -> *). GVal m -> Maybe Value
asJSON GVal m
g
        }

-- | Marshal a GVal between carrier monads.
-- Unlike 'marshalGVal', 'asFunction' information is retained by hoisting
-- them using the provided hoisting functions. For 'Run' monads, which is
-- what 'GVal' is typically used with, the 'hoistRun' function can be used
-- to construct suitable hoisting functions.
marshalGValEx :: (Functor m, Functor n)
              => (forall a. m a -> n a)
              -> (forall a. n a -> m a)
              -> GVal m
              -> GVal n
marshalGValEx :: forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. m a -> n a
hoist forall a. n a -> m a
unhoist GVal m
g =
    GVal
        { asList :: Maybe [GVal n]
asList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. m a -> n a
hoist forall a. n a -> m a
unhoist) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g
        , asDictItems :: Maybe [(Text, GVal n)]
asDictItems = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(Text, GVal m)]
items -> [(Text
k, forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. m a -> n a
hoist forall a. n a -> m a
unhoist GVal m
v) | (Text
k, GVal m
v) <- [(Text, GVal m)]
items]) (forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
g)
        , asLookup :: Maybe (Text -> Maybe (GVal n))
asLookup = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. m a -> n a
hoist forall a. n a -> m a
unhoist) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup GVal m
g)
        , asHtml :: Html
asHtml = forall (m :: * -> *). GVal m -> Html
asHtml GVal m
g
        , asText :: Text
asText = forall (m :: * -> *). GVal m -> Text
asText GVal m
g
        , asBytes :: Maybe ByteString
asBytes = forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
g
        , asBoolean :: Bool
asBoolean = forall (m :: * -> *). GVal m -> Bool
asBoolean GVal m
g
        , asNumber :: Maybe Scientific
asNumber = forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
g
        , asFunction :: Maybe (Function n)
asFunction = forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> Function m -> Function n
marshalFunction forall a. m a -> n a
hoist forall a. n a -> m a
unhoist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe (Function m)
asFunction GVal m
g
        , isNull :: Bool
isNull = forall (m :: * -> *). GVal m -> Bool
isNull GVal m
g
        , length :: Maybe Int
length = forall (m :: * -> *). GVal m -> Maybe Int
length GVal m
g
        , asJSON :: Maybe Value
asJSON = forall (m :: * -> *). GVal m -> Maybe Value
asJSON GVal m
g
        }

marshalFunction :: (Functor m, Functor n) => (forall a. m a -> n a) -> (forall a. n a -> m a) -> Function m -> Function n
-- [(Maybe Text, GVal m)] -> m (GVal m)
marshalFunction :: forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> Function m -> Function n
marshalFunction forall a. m a -> n a
hoist forall a. n a -> m a
unhoist Function m
f [(Maybe Text, GVal n)]
args =
    let args' :: [(Maybe Text, GVal m)]
args' = [ (Maybe Text
name, forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. n a -> m a
unhoist forall a. m a -> n a
hoist GVal n
value)
                | (Maybe Text
name, GVal n
value) <- [(Maybe Text, GVal n)]
args
                ]
    in forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx forall a. m a -> n a
hoist forall a. n a -> m a
unhoist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. m a -> n a
hoist (Function m
f [(Maybe Text, GVal m)]
args')

-- | Convenience wrapper around 'asDictItems' to represent a 'GVal' as a
-- 'HashMap'.
asHashMap :: GVal m -> Maybe (HashMap Text (GVal m))
asHashMap :: forall (m :: * -> *). GVal m -> Maybe (HashMap Text (GVal m))
asHashMap GVal m
g = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
g

-- | The default 'GVal' is equivalent to NULL.
instance Default (GVal m) where
    def :: GVal m
def = GVal
            { asList :: Maybe [GVal m]
asList = forall a. Maybe a
Nothing
            , asDictItems :: Maybe [(Text, GVal m)]
asDictItems = forall a. Maybe a
Nothing
            , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = forall a. Maybe a
Nothing
            , asHtml :: Html
asHtml = Text -> Html
unsafeRawHtml Text
""
            , asText :: Text
asText = Text
""
            , asBytes :: Maybe ByteString
asBytes = forall a. Maybe a
Nothing
            , asBoolean :: Bool
asBoolean = Bool
False
            , asNumber :: Maybe Scientific
asNumber = forall a. Maybe a
Nothing
            , asFunction :: Maybe (Function m)
asFunction = forall a. Maybe a
Nothing
            , isNull :: Bool
isNull = Bool
True
            , length :: Maybe Int
length = forall a. Maybe a
Nothing
            , asJSON :: Maybe Value
asJSON = forall a. Maybe a
Nothing
            }

-- | Conversion to JSON values attempts the following conversions, in order:
--
-- - check the 'isNull' property; if it is 'True', always return 'Null',
--   even if the GVal implements 'asJSON'
-- - 'asJSON'
-- - 'asList'
-- - 'asDictItems' (through 'asHashMap')
-- - 'asNumber'
-- - 'asText'
--
-- Note that the default conversions will never return booleans unless 'asJSON'
-- explicitly does this, because 'asText' will always return *something*.
instance JSON.ToJSON (GVal m) where
    toJSON :: GVal m -> Value
toJSON GVal m
g =
        if forall (m :: * -> *). GVal m -> Bool
isNull GVal m
g
            then Value
JSON.Null
            else forall a. a -> Maybe a -> a
fromMaybe (forall a. ToJSON a => a -> Value
JSON.toJSON forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GVal m -> Text
asText GVal m
g) forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *). GVal m -> Maybe Value
asJSON GVal m
g forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    (forall a. ToJSON a => a -> Value
JSON.toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    (forall a. ToJSON a => a -> Value
JSON.toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe (HashMap Text (GVal m))
asHashMap GVal m
g) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    (forall a. ToJSON a => a -> Value
JSON.toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
g)

-- | For convenience, 'Show' is implemented in a way that looks similar to
-- JavaScript / JSON
instance Show (GVal m) where
    show :: GVal m -> String
show GVal m
v
        | forall (m :: * -> *). GVal m -> Bool
isNull GVal m
v = String
"null"
        | forall a. Maybe a -> Bool
isJust (forall (m :: * -> *). GVal m -> Maybe (Function m)
asFunction GVal m
v) = String
"<<function>>"
        | forall a. Maybe a -> Bool
isJust (forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
v) =
            let items :: [String]
items = [ forall a. Show a => a -> String
show Text
k forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GVal m
v | (Text
k, GVal m
v) <- forall a. a -> Maybe a -> a
fromMaybe [] (forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
v) ]
                      forall a. [a] -> [a] -> [a]
++ [ forall a. Show a => a -> String
show Integer
k forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GVal m
v | (Integer
k, GVal m
v) <- forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Integer
0..] (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
v) ]
            in String
"{" forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
List.intersperse String
", " forall a b. (a -> b) -> a -> b
$ [String]
items) forall a. Semigroup a => a -> a -> a
<> String
"}"
        | forall a. Maybe a -> Bool
isJust (forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
v) = String
"[" forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
List.intersperse String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] (forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
v)) forall a. Semigroup a => a -> a -> a
<> String
"]"
        | forall a. Maybe a -> Bool
isJust (forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
v) =
            case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
v :: Maybe (Either Double Integer) of
                Just (Left Double
x) -> forall a. Show a => a -> String
show (forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
v)
                Just (Right Integer
x) -> forall a. Show a => a -> String
show Integer
x
                Maybe (Either Double Integer)
Nothing -> String
""
        | Bool
otherwise = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GVal m -> Text
asText GVal m
v

-- | Converting to HTML hooks into the ToHtml instance for 'Text' for most tags.
-- Tags that have no obvious textual representation render as empty HTML.
instance ToHtml (GVal m) where
    toHtml :: GVal m -> Html
toHtml = forall (m :: * -> *). GVal m -> Html
asHtml

instance PrintfArg (GVal m) where
    formatArg :: GVal m -> FieldFormatter
formatArg GVal m
x FieldFormat
fmt =
        case FieldFormat -> Char
fmtChar (Char -> FieldFormat -> FieldFormat
vFmt Char
's' FieldFormat
fmt) of
            Char
's' -> forall a. IsChar a => [a] -> FieldFormatter
formatString
                    (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GVal m -> Text
asText GVal m
x)
                    (FieldFormat
fmt { fmtChar :: Char
fmtChar = Char
's', fmtPrecision :: Maybe Int
fmtPrecision = forall a. Maybe a
Nothing })
            Char
'c' -> forall a. IsChar a => [a] -> FieldFormatter
formatString
                    (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GVal m -> Text
asText GVal m
x)
                    FieldFormat
fmt
            Char
f -> if Char
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Char
'f', Char
'F', Char
'g', Char
'G', Char
'e', Char
'E']
                    then forall a. RealFloat a => a -> FieldFormatter
formatRealFloat (forall a. RealFloat a => Scientific -> a
toRealFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Scientific
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber forall a b. (a -> b) -> a -> b
$ GVal m
x) FieldFormat
fmt
                    else Integer -> FieldFormatter
formatInteger (forall a b. (RealFrac a, Integral b) => a -> b
Prelude.round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Scientific
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber forall a b. (a -> b) -> a -> b
$ GVal m
x) FieldFormat
fmt

-- * Representing functions as 'GVal's
--
-- | A function that can be called from within a template execution context.
type Function m = [(Maybe Text, GVal m)] -> m (GVal m)

-- | Match arguments passed to a function at runtime against a list of declared
-- argument names.
-- @matchFuncArgs argNames argsPassed@ returns @(matchedArgs, positionalArgs, namedArgs)@,
-- where @matchedArgs@ is a list of arguments matched against declared names
-- (by name or by position), @positionalArgs@ are the unused positional
-- (unnamed) arguments, and @namedArgs@ are the unused named arguments.
matchFuncArgs :: [Text] -> [(Maybe Text, GVal m)] -> (HashMap Text (GVal m), [GVal m], HashMap Text (GVal m))
matchFuncArgs :: forall (m :: * -> *).
[Text]
-> [(Maybe Text, GVal m)]
-> (HashMap Text (GVal m), [GVal m], HashMap Text (GVal m))
matchFuncArgs [Text]
names [(Maybe Text, GVal m)]
args =
    (HashMap Text (GVal m)
matched, [GVal m]
positional, HashMap Text (GVal m)
named)
    where
        positionalRaw :: [GVal m]
positionalRaw = [ GVal m
v | (Maybe Text
Nothing, GVal m
v) <- [(Maybe Text, GVal m)]
args ]
        namedRaw :: HashMap Text (GVal m)
namedRaw = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Text
n, GVal m
v) | (Just Text
n, GVal m
v) <- [(Maybe Text, GVal m)]
args ]
        fromPositional :: [(Text, GVal m)]
fromPositional = forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Text]
names [GVal m]
positionalRaw
        numPositional :: Int
numPositional = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [(Text, GVal m)]
fromPositional
        namesRemaining :: [Text]
namesRemaining = forall a. Int -> [a] -> [a]
Prelude.drop Int
numPositional [Text]
names
        positional :: [GVal m]
positional = forall a. Int -> [a] -> [a]
Prelude.drop Int
numPositional [GVal m]
positionalRaw
        fromNamed :: [(Text, GVal m)]
fromNamed = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Text, GVal m)
lookupName [Text]
namesRemaining
        lookupName :: Text -> Maybe (Text, GVal m)
lookupName Text
n = do
            GVal m
v <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
n HashMap Text (GVal m)
namedRaw
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
n, GVal m
v)
        matched :: HashMap Text (GVal m)
matched = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ [(Text, GVal m)]
fromPositional forall a. [a] -> [a] -> [a]
++ [(Text, GVal m)]
fromNamed
        named :: HashMap Text (GVal m)
named = forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference HashMap Text (GVal m)
namedRaw (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, GVal m)]
fromNamed)

-- * Marshalling from Haskell to 'GVal'
--
-- | Types that implement conversion to 'GVal'.
class ToGVal m a where
    toGVal :: a -> GVal m

-- | Trivial instance for 'GVal' itself.
instance ToGVal m (GVal m) where
    toGVal :: GVal m -> GVal m
toGVal = forall a. a -> a
id

instance ToGVal m () where
    toGVal :: () -> GVal m
toGVal = forall a b. a -> b -> a
const forall a. Default a => a
def

-- | 'Nothing' becomes NULL, 'Just' unwraps.
instance ToGVal m v => ToGVal m (Maybe v) where
    toGVal :: Maybe v -> GVal m
toGVal Maybe v
Nothing = forall a. Default a => a
def { asJSON :: Maybe Value
asJSON = forall a. a -> Maybe a
Just Value
JSON.Null }
    toGVal (Just v
x) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal v
x

-- | Haskell lists become list-like 'GVal's
instance ToGVal m v => ToGVal m [v] where
    toGVal :: [v] -> GVal m
toGVal [v]
xs = [GVal m] -> GVal m
helper (forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [v]
xs)
        where
            helper :: [GVal m] -> GVal m
            helper :: [GVal m] -> GVal m
helper [GVal m]
xs =
                forall a. Default a => a
def
                    { asHtml :: Html
asHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Html
asHtml forall a b. (a -> b) -> a -> b
$ [GVal m]
xs
                    , asText :: Text
asText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Text
asText forall a b. (a -> b) -> a -> b
$ [GVal m]
xs
                    , asBytes :: Maybe ByteString
asBytes = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes forall a b. (a -> b) -> a -> b
$ [GVal m]
xs
                    , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null forall a b. (a -> b) -> a -> b
$ [GVal m]
xs
                    , isNull :: Bool
isNull = Bool
False
                    , asList :: Maybe [GVal m]
asList = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [GVal m]
xs
                    , length :: Maybe Int
length = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GVal m]
xs
                    }

-- | 'HashMap' of 'Text' becomes a dictionary-like 'GVal'
instance ToGVal m v => ToGVal m (HashMap Text v) where
    toGVal :: HashMap Text v -> GVal m
toGVal HashMap Text v
xs = HashMap Text (GVal m) -> GVal m
helper (forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal HashMap Text v
xs)
        where
            helper :: HashMap Text (GVal m) -> GVal m
            helper :: HashMap Text (GVal m) -> GVal m
helper HashMap Text (GVal m)
xs =
                forall a. Default a => a
def
                    { asHtml :: Html
asHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Html
asHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
HashMap.elems forall a b. (a -> b) -> a -> b
$ HashMap Text (GVal m)
xs
                    , asText :: Text
asText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 k v. HashMap k v -> [v]
HashMap.elems forall a b. (a -> b) -> a -> b
$ HashMap Text (GVal m)
xs
                    , asBytes :: Maybe ByteString
asBytes = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
HashMap.elems forall a b. (a -> b) -> a -> b
$ HashMap Text (GVal m)
xs
                    , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> Bool
HashMap.null forall a b. (a -> b) -> a -> b
$ HashMap Text (GVal m)
xs
                    , isNull :: Bool
isNull = Bool
False
                    , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = forall a. a -> Maybe a
Just (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Text (GVal m)
xs)
                    , asDictItems :: Maybe [(Text, GVal m)]
asDictItems = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text (GVal m)
xs
                    }

-- | 'Map' of 'Text' becomes a dictionary-like 'GVal'
instance ToGVal m v => ToGVal m (Map Text v) where
    toGVal :: Map Text v -> GVal m
toGVal Map Text v
xs = Map Text (GVal m) -> GVal m
helper (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Map Text v
xs)
        where
            helper :: Map Text (GVal m) -> GVal m
            helper :: Map Text (GVal m) -> GVal m
helper Map Text (GVal m)
xs =
                forall a. Default a => a
def
                    { asHtml :: Html
asHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Html
asHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Map Text (GVal m)
xs
                    , asText :: Text
asText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Map Text (GVal m)
xs
                    , asBytes :: Maybe ByteString
asBytes = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Map Text (GVal m)
xs
                    , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Bool
Map.null forall a b. (a -> b) -> a -> b
$ Map Text (GVal m)
xs
                    , isNull :: Bool
isNull = Bool
False
                    , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = forall a. a -> Maybe a
Just (forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text (GVal m)
xs)
                    , asDictItems :: Maybe [(Text, GVal m)]
asDictItems = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text (GVal m)
xs
                    }

instance ToGVal m Int where
    toGVal :: Int -> GVal m
toGVal Int
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
x
            , asText :: Text
asText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
x
            , asBoolean :: Bool
asBoolean = Int
x forall a. Eq a => a -> a -> Bool
/= Int
0
            , asNumber :: Maybe Scientific
asNumber = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m Integer where
    toGVal :: Integer -> GVal m
toGVal Integer
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
x
            , asText :: Text
asText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
x
            , asBoolean :: Bool
asBoolean = Integer
x forall a. Eq a => a -> a -> Bool
/= Integer
0
            , asNumber :: Maybe Scientific
asNumber = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m Scientific where
    toGVal :: Scientific -> GVal m
toGVal Scientific
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Scientific -> Text
scientificToText Scientific
x
            , asText :: Text
asText = Scientific -> Text
scientificToText Scientific
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Text
scientificToText forall a b. (a -> b) -> a -> b
$ Scientific
x
            , asBoolean :: Bool
asBoolean = Scientific
x forall a. Eq a => a -> a -> Bool
/= Scientific
0
            , asNumber :: Maybe Scientific
asNumber = forall a. a -> Maybe a
Just Scientific
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m Day where
    toGVal :: Day -> GVal m
toGVal Day
x =
        let dayDict :: [(Text, GVal m)]
dayDict = forall (m :: * -> *). Day -> [(Text, GVal m)]
dayToDict Day
x
            julian :: Integer
julian = Day -> Integer
toModifiedJulianDay Day
x
            formatted :: Text
formatted = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%0Y-%m-%d" Day
x
        in (forall (m :: * -> *). [Pair m] -> GVal m
orderedDict forall {m :: * -> *}. [(Text, GVal m)]
dayDict)
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asText :: Text
asText = Text
formatted
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asBoolean :: Bool
asBoolean = Bool
True
            , asNumber :: Maybe Scientific
asNumber = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
julian
            , asList :: Maybe [GVal m]
asList = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. (a, b) -> b
snd forall {m :: * -> *}. [(Text, GVal m)]
dayDict)
            }

dayToDict :: Day -> [(Text, GVal m)]
dayToDict :: forall (m :: * -> *). Day -> [(Text, GVal m)]
dayToDict Day
x =
    let (Integer
year, Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
x
    in [ Text
"year" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Integer
year
        , Text
"month" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
month
        , Text
"day" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
day
        ]

instance ToGVal m TimeOfDay where
    toGVal :: TimeOfDay -> GVal m
toGVal TimeOfDay
x =
        let timeDict :: [(Text, GVal m)]
timeDict = forall (m :: * -> *). TimeOfDay -> [(Text, GVal m)]
timeToDict TimeOfDay
x
            formatted :: Text
formatted = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S" TimeOfDay
x
        in (forall (m :: * -> *). [Pair m] -> GVal m
orderedDict forall {m :: * -> *}. [(Text, GVal m)]
timeDict)
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asText :: Text
asText = Text
formatted
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asBoolean :: Bool
asBoolean = Bool
True
            , asNumber :: Maybe Scientific
asNumber = forall a. Maybe a
Nothing
            , asList :: Maybe [GVal m]
asList = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. (a, b) -> b
snd forall {m :: * -> *}. [(Text, GVal m)]
timeDict)
            }

timeToDict :: TimeOfDay -> [(Text, GVal m)]
timeToDict :: forall (m :: * -> *). TimeOfDay -> [(Text, GVal m)]
timeToDict (TimeOfDay Int
hours Int
minutes Pico
seconds) =
    [ Text
"hours" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
hours
    , Text
"minutes" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
minutes
    , Text
"seconds" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Pico -> Scientific
picoToScientific Pico
seconds
    ]

instance ToGVal m LocalTime where
    toGVal :: LocalTime -> GVal m
toGVal LocalTime
x =
        let dtDict :: [(Text, GVal m)]
dtDict = forall (m :: * -> *). LocalTime -> [(Text, GVal m)]
localTimeToDict LocalTime
x
            formatted :: Text
formatted = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%0Y-%m-%d %H:%M:%S" LocalTime
x
        in (forall (m :: * -> *). [Pair m] -> GVal m
orderedDict forall a b. (a -> b) -> a -> b
$
                forall {m :: * -> *}. [(Text, GVal m)]
dtDict forall a. [a] -> [a] -> [a]
++
                [ Text
"date" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> LocalTime -> Day
localDay LocalTime
x
                , Text
"time" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> LocalTime -> TimeOfDay
localTimeOfDay LocalTime
x
                ])
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asText :: Text
asText = Text
formatted
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asBoolean :: Bool
asBoolean = Bool
True
            , asNumber :: Maybe Scientific
asNumber = forall a. Maybe a
Nothing
            , asList :: Maybe [GVal m]
asList = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. (a, b) -> b
snd forall {m :: * -> *}. [(Text, GVal m)]
dtDict)
            }

localTimeToDict :: LocalTime -> [(Text, GVal m)]
localTimeToDict :: forall (m :: * -> *). LocalTime -> [(Text, GVal m)]
localTimeToDict LocalTime
x =
        let dayDict :: [(Text, GVal m)]
dayDict = forall (m :: * -> *). Day -> [(Text, GVal m)]
dayToDict forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
x
            timeDict :: [(Text, GVal m)]
timeDict = forall (m :: * -> *). TimeOfDay -> [(Text, GVal m)]
timeToDict forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
x
        in forall {m :: * -> *}. [(Text, GVal m)]
dayDict forall a. [a] -> [a] -> [a]
++ forall {m :: * -> *}. [(Text, GVal m)]
timeDict

instance ToGVal m TimeZone where
    toGVal :: TimeZone -> GVal m
toGVal  = forall (m :: * -> *). [Pair m] -> GVal m
dict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). TimeZone -> [(Text, GVal m)]
timeZoneToDict

timeZoneToDict :: TimeZone -> [(Text, GVal m)]
timeZoneToDict :: forall (m :: * -> *). TimeZone -> [(Text, GVal m)]
timeZoneToDict (TimeZone Int
minutes Bool
summerOnly String
name) =
    [ Text
"minutes" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
minutes
    , Text
"summerOnly" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Bool
summerOnly
    , Text
"name" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> String
name
    ]

instance ToGVal m TimeLocale where
    toGVal :: TimeLocale -> GVal m
toGVal TimeLocale
t =
        let formattedExample :: Text
formattedExample =
                String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
t String
"%c" forall a b. (a -> b) -> a -> b
$
                    Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
1 Int
1) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
13 Int
15 Pico
00)
            timeLocaleDict :: [(Text, GVal m)]
timeLocaleDict = forall (m :: * -> *). TimeLocale -> [(Text, GVal m)]
timeLocaleToDict TimeLocale
t
        in (forall (m :: * -> *). [Pair m] -> GVal m
dict forall {m :: * -> *}. [(Text, GVal m)]
timeLocaleDict)
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Text
formattedExample
            , asText :: Text
asText = Text
formattedExample
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
formattedExample
            , asBoolean :: Bool
asBoolean = Bool
True
            , asNumber :: Maybe Scientific
asNumber = forall a. Maybe a
Nothing
            }

timeLocaleToDict :: TimeLocale -> [(Text, GVal m)]
timeLocaleToDict :: forall (m :: * -> *). TimeLocale -> [(Text, GVal m)]
timeLocaleToDict TimeLocale
t =
    [ Text
"wDays" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> forall a b. (a -> b) -> [a] -> [b]
List.map (String, String) -> (Text, Text)
packPair (TimeLocale -> [(String, String)]
wDays TimeLocale
t)
    , Text
"months" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> forall a b. (a -> b) -> [a] -> [b]
List.map (String, String) -> (Text, Text)
packPair (TimeLocale -> [(String, String)]
months TimeLocale
t)
    , Text
"amPm" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (String, String) -> (Text, Text)
packPair (TimeLocale -> (String, String)
amPm TimeLocale
t)
    , Text
"dateTimeFmt" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> String -> Text
Text.pack (TimeLocale -> String
dateTimeFmt TimeLocale
t)
    , Text
"dateFmt" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> String -> Text
Text.pack (TimeLocale -> String
dateFmt TimeLocale
t)
    , Text
"timeFmt" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> String -> Text
Text.pack (TimeLocale -> String
timeFmt TimeLocale
t)
    , Text
"time12Fmt" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> String -> Text
Text.pack (TimeLocale -> String
time12Fmt TimeLocale
t)
    -- TODO
    -- , "knownTimeZones" ~> knownTimeZones t
    , Text
"knownTimeZones" forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ([] :: [Text])
    ]

-- TODO: ToGVal instance for ZonedTime
instance ToGVal m ZonedTime where
    toGVal :: ZonedTime -> GVal m
toGVal ZonedTime
x =
        let dtDict :: [(Text, GVal m)]
dtDict = forall (m :: * -> *). ZonedTime -> [(Text, GVal m)]
zonedTimeToDict ZonedTime
x
            formatted :: Text
formatted = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%0Y-%m-%d %H:%M:%S%z" ZonedTime
x
        in (forall (m :: * -> *). [Pair m] -> GVal m
dict forall {m :: * -> *}. [(Text, GVal m)]
dtDict)
            { asHtml :: Html
asHtml = Text -> Html
html forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asText :: Text
asText = Text
formatted
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
formatted
            , asBoolean :: Bool
asBoolean = Bool
True
            , asNumber :: Maybe Scientific
asNumber = forall a. Maybe a
Nothing
            }

zonedTimeToDict :: ZonedTime -> [(Text, GVal m)]
zonedTimeToDict :: forall (m :: * -> *). ZonedTime -> [(Text, GVal m)]
zonedTimeToDict ZonedTime
t =
    (Text
"tz", forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall a b. (a -> b) -> a -> b
$ ZonedTime -> TimeZone
zonedTimeZone ZonedTime
t)forall a. a -> [a] -> [a]
:forall (m :: * -> *). LocalTime -> [(Text, GVal m)]
localTimeToDict (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
t)

instance (ToGVal m a, ToGVal m b) => ToGVal m (a, b) where
    toGVal :: (a, b) -> GVal m
toGVal (a
a, b
b) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ([ forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
a, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal b
b ] :: [GVal m])

instance (ToGVal m a, ToGVal m b, ToGVal m c) => ToGVal m (a, b, c) where
    toGVal :: (a, b, c) -> GVal m
toGVal (a
a, b
b, c
c) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ([ forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
a, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal b
b, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal c
c ] :: [GVal m])

instance (ToGVal m a, ToGVal m b, ToGVal m c, ToGVal m d) => ToGVal m (a, b, c, d) where
    toGVal :: (a, b, c, d) -> GVal m
toGVal (a
a, b
b, c
c, d
d) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ([ forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
a, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal b
b, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal c
c, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal d
d ] :: [GVal m])

-- | Silly helper function, needed to bypass the default 'Show' instance of
-- 'Scientific' in order to make integral 'Scientific's look like integers.
scientificToText :: Scientific -> Text
scientificToText :: Scientific -> Text
scientificToText Scientific
x =
    String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x of
        Left Double
x -> forall a. Show a => a -> String
show Double
x
        Right Integer
x -> forall a. Show a => a -> String
show Integer
x

-- | Booleans render as 1 or empty string, and otherwise behave as expected.
instance ToGVal m Bool where
    toGVal :: Bool -> GVal m
toGVal Bool
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = if Bool
x then Text -> Html
html Text
"1" else Text -> Html
html Text
""
            , asText :: Text
asText = if Bool
x then Text
"1" else Text
""
            , asBoolean :: Bool
asBoolean = Bool
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if Bool
x then ByteString
"1" else ByteString
"0"
            , asNumber :: Maybe Scientific
asNumber = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if Bool
x then Scientific
1 else Scientific
0
            , isNull :: Bool
isNull = Bool
False
            , asJSON :: Maybe Value
asJSON = forall a. a -> Maybe a
Just (Bool -> Value
JSON.Bool Bool
x)
            }

-- | 'String' -> 'GVal' conversion uses the 'IsString' class; because 'String'
-- is an alias for '[Char]', there is also a 'ToGVal' instance for 'String',
-- but it marshals strings as lists of characters, i.e., calling 'toGVal' on
-- a string produces a list of characters on the 'GVal' side.
instance IsString (GVal m) where
    fromString :: String -> GVal m
fromString String
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
x
            , asText :: Text
asText = String -> Text
Text.pack String
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null String
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay String
x
            , isNull :: Bool
isNull = Bool
False
            , length :: Maybe Int
length = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length forall a b. (a -> b) -> a -> b
$ String
x
            }

-- | Single characters are treated as length-1 'Text's.
instance ToGVal m Char where
    toGVal :: Char -> GVal m
toGVal = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton

instance ToGVal m Text where
    toGVal :: Text -> GVal m
toGVal Text
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html Text
x
            , asText :: Text
asText = Text
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
Text.null Text
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Text
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m LText.Text where
    toGVal :: Text -> GVal m
toGVal Text
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html (Text -> Text
LText.toStrict Text
x)
            , asText :: Text
asText = Text -> Text
LText.toStrict Text
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LText.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
LText.null Text
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LText.unpack forall a b. (a -> b) -> a -> b
$ Text
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m ByteString where
    toGVal :: ByteString -> GVal m
toGVal ByteString
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html (ByteString -> Text
decodeUtf8 ByteString
x)
            , asText :: Text
asText = ByteString -> Text
decodeUtf8 ByteString
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just ByteString
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
BS.null ByteString
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
x
            , isNull :: Bool
isNull = Bool
False
            }

instance ToGVal m LBS.ByteString where
    toGVal :: ByteString -> GVal m
toGVal ByteString
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Text -> Html
html forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LText.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
x
            , asText :: Text
asText = Text -> Text
LText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LText.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
x
            , asBytes :: Maybe ByteString
asBytes = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ ByteString
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
LBS.null ByteString
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LText.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LText.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
x
            , isNull :: Bool
isNull = Bool
False
            }
--
-- | This instance is slightly wrong; the 'asBoolean', 'asNumber', and 'asText'
-- methods all treat the HTML source as plain text. We do this to avoid parsing
-- the HTML back into a 'Text' (and dealing with possible parser errors); the
-- reason this instance exists at all is that we still want to be able to pass
-- pre-rendered HTML around sometimes, and as long as we don't call any numeric
-- or string functions on it, everything is fine. When such HTML values
-- accidentally do get used as strings, the HTML source will bleed into the
-- visible text, but at least this will not introduce an XSS vulnerability.
--
-- It is therefore recommended to avoid passing 'Html' values into templates,
-- and also to avoid calling any string functions on 'Html' values inside
-- templates (e.g. capturing macro output and then passing it through a textual
-- filter).
instance ToGVal m Html where
    toGVal :: Html -> GVal m
toGVal Html
x =
        forall a. Default a => a
def
            { asHtml :: Html
asHtml = Html
x
            , asText :: Text
asText = Html -> Text
htmlSource Html
x
            , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlSource forall a b. (a -> b) -> a -> b
$ Html
x
            , asNumber :: Maybe Scientific
asNumber = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlSource forall a b. (a -> b) -> a -> b
$ Html
x
            , isNull :: Bool
isNull = Bool
False
            }

-- | Convert Aeson 'Value's to 'GVal's over an arbitrary host monad. Because
-- JSON cannot represent functions, this conversion will never produce a
-- 'Function'. Further, the 'ToJSON' instance for such a 'GVal' will always
-- produce the exact 'Value' that was use to construct the it.
instance ToGVal m JSON.Value where
    toGVal :: Value -> GVal m
toGVal Value
j = (forall (m :: * -> *). Value -> GVal m
rawJSONToGVal Value
j) { asJSON :: Maybe Value
asJSON = forall a. a -> Maybe a
Just Value
j }

rawJSONToGVal :: JSON.Value -> GVal m
rawJSONToGVal :: forall (m :: * -> *). Value -> GVal m
rawJSONToGVal (JSON.Number Scientific
n) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Scientific
n
rawJSONToGVal (JSON.String Text
s) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Text
s
rawJSONToGVal (JSON.Bool Bool
b) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
b
rawJSONToGVal Value
JSON.Null = forall a. Default a => a
def
rawJSONToGVal (JSON.Array Array
a) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Array
a
rawJSONToGVal (JSON.Object Object
o) = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Object
o

#if MIN_VERSION_aeson(2,0,0)
-- | 'AKM.KeyMap' of 'JSON.Value' becomes a dictionary-like 'GVal'
instance ToGVal m (AKM.KeyMap JSON.Value) where
    toGVal :: Object -> GVal m
toGVal Object
xs = KeyMap (GVal m) -> GVal m
helper (forall a b. (a -> b) -> KeyMap a -> KeyMap b
AKM.map forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Object
xs)
        where
            helper :: AKM.KeyMap (GVal m) -> GVal m
            helper :: KeyMap (GVal m) -> GVal m
helper KeyMap (GVal m)
xs =
                forall a. Default a => a
def
                    { asHtml :: Html
asHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall (m :: * -> *). GVal m -> Html
asHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
AKM.toList forall a b. (a -> b) -> a -> b
$ KeyMap (GVal m)
xs
                    , asText :: Text
asText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall (m :: * -> *). GVal m -> Text
asText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
AKM.toList forall a b. (a -> b) -> a -> b
$ KeyMap (GVal m)
xs
                    , asBytes :: Maybe ByteString
asBytes = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
AKM.toList forall a b. (a -> b) -> a -> b
$ KeyMap (GVal m)
xs
                    , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> Bool
AKM.null forall a b. (a -> b) -> a -> b
$ KeyMap (GVal m)
xs
                    , isNull :: Bool
isNull = Bool
False
                    , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall v. Key -> KeyMap v -> Maybe v
`AKM.lookup` KeyMap (GVal m)
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
AK.fromText
                    , asDictItems :: Maybe [(Text, GVal m)]
asDictItems = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (\(Key
k,GVal m
v) -> (Key -> Text
AK.toText Key
k, GVal m
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
AKM.toList forall a b. (a -> b) -> a -> b
$ KeyMap (GVal m)
xs
                    }
#endif

-- | Turn a 'Function' into a 'GVal'
fromFunction :: Function m -> GVal m
fromFunction :: forall (m :: * -> *). Function m -> GVal m
fromFunction Function m
f =
    forall a. Default a => a
def
        { asHtml :: Html
asHtml = Text -> Html
html Text
""
        , asText :: Text
asText = Text
""
        , asBoolean :: Bool
asBoolean = Bool
True
        , isNull :: Bool
isNull = Bool
False
        , asFunction :: Maybe (Function m)
asFunction = forall a. a -> Maybe a
Just Function m
f
        , asJSON :: Maybe Value
asJSON = forall a. a -> Maybe a
Just Value
"<<function>>"
        }


-- * Convenience API for constructing heterogenous dictionaries.
--
-- Example usage:
--
-- > context :: GVal m
-- > context = dict [ "number" ~> (15 :: Int), "name" ~> ("Joe" :: String) ]

-- | A key/value pair, used for constructing dictionary GVals using a
-- compact syntax.
type Pair m = (Text, GVal m)

-- | Construct a dictionary GVal from a list of pairs. Internally, this uses
-- a hashmap, so element order will not be preserved.
dict :: [Pair m] -> GVal m
dict :: forall (m :: * -> *). [Pair m] -> GVal m
dict = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

-- | Construct an ordered dictionary GVal from a list of pairs. Internally,
-- this conversion uses both a hashmap (for O(1) lookup) and the original list,
-- so element order is preserved, but there is a bit of a memory overhead.
orderedDict :: [Pair m] -> GVal m
orderedDict :: forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [Pair m]
xs =
    forall a. Default a => a
def
        { asHtml :: Html
asHtml = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall (m :: * -> *). GVal m -> Html
asHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [Pair m]
xs
        , asText :: Text
asText = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$ [Pair m]
xs
        , asBoolean :: Bool
asBoolean = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null forall a b. (a -> b) -> a -> b
$ [Pair m]
xs
        , isNull :: Bool
isNull = Bool
False
        , asLookup :: Maybe (Text -> Maybe (GVal m))
asLookup = forall a. a -> Maybe a
Just (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Text (GVal m)
hm)
        , asDictItems :: Maybe [Pair m]
asDictItems = forall a. a -> Maybe a
Just [Pair m]
xs
        }
    where
        hm :: HashMap Text (GVal m)
hm = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [Pair m]
xs

-- | Construct a pair from a key and a value.
(~>) :: ToGVal m a => Text -> a -> Pair m
Text
k ~> :: forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> a
v = (Text
k, forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
v)
infixr 8 ~>

-- * Convenience API for constructing heterogenous lists

type Cons m = [GVal m]

-- | Alias for '(~:)'.
gcons :: ToGVal m a => a -> Cons m -> Cons m
gcons :: forall (m :: * -> *) a. ToGVal m a => a -> Cons m -> Cons m
gcons = (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal

-- | This operator allows constructing heterogenous lists using cons-style
-- syntax, e.g.:
--
-- >>> asText $ list ("Found " ~: (6 :: Int) ~: " items" ~: [] :: [GVal IO])
-- "Found 6 items"
(~:) :: ToGVal m a => a -> Cons m -> Cons m
~: :: forall (m :: * -> *) a. ToGVal m a => a -> Cons m -> Cons m
(~:) = forall (m :: * -> *) a. ToGVal m a => a -> Cons m -> Cons m
gcons
infixr 5 ~:

-- | Construct a GVal from a list of GVals. This is equivalent to the 'toGVal'
-- implementation of @[GVal m]@, but typed more narrowly for clarity and
-- disambiguation.
list :: Cons m -> GVal m
list :: forall (m :: * -> *). Cons m -> GVal m
list = forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal

-- * Inspecting 'GVal's / Marshalling 'GVal' to Haskell

-- | Check if the given GVal is a list-like object
isList :: GVal m -> Bool
isList :: forall (m :: * -> *). GVal m -> Bool
isList = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList

-- | Check if the given GVal is a dictionary-like object
isDict :: GVal m -> Bool
isDict :: forall (m :: * -> *). GVal m -> Bool
isDict = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems

-- | Treat a 'GVal' as a flat list and look up a value by integer index.
-- If the value is not a List, or if the index exceeds the list length,
-- return 'Nothing'.
lookupIndex :: Int -> GVal m -> Maybe (GVal m)
lookupIndex :: forall (m :: * -> *). Int -> GVal m -> Maybe (GVal m)
lookupIndex = forall (m :: * -> *). Maybe Int -> GVal m -> Maybe (GVal m)
lookupIndexMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

-- | Helper function; look up a value by an integer index when the index may or
-- may not be available. If no index is given, return 'Nothing'.
lookupIndexMay :: Maybe Int -> GVal m -> Maybe (GVal m)
lookupIndexMay :: forall (m :: * -> *). Maybe Int -> GVal m -> Maybe (GVal m)
lookupIndexMay Maybe Int
i GVal m
v = do
    Int
index <- Maybe Int
i
    [GVal m]
items <- forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
v
    forall a. [a] -> Int -> Maybe a
atMay [GVal m]
items Int
index

-- | Strictly-typed lookup: treat value as a dictionary-like object and look
-- up the value at a given key.
lookupKey :: Text -> GVal m -> Maybe (GVal m)
lookupKey :: forall (m :: * -> *). Text -> GVal m -> Maybe (GVal m)
lookupKey Text
k GVal m
v = do
    Text -> Maybe (GVal m)
lf <- forall (m :: * -> *). GVal m -> Maybe (Text -> Maybe (GVal m))
asLookup GVal m
v
    Text -> Maybe (GVal m)
lf Text
k

-- | Loosely-typed lookup: try dictionary-style lookup first (treat index as
-- a string, and container as a dictionary), if that doesn't yield anything
-- (either because the index is not string-ish, or because the container
-- doesn't provide dictionary-style access), try index-based lookup.
lookupLoose :: GVal m -> GVal m -> Maybe (GVal m)
lookupLoose :: forall (m :: * -> *). GVal m -> GVal m -> Maybe (GVal m)
lookupLoose GVal m
k GVal m
v =
    forall (m :: * -> *). Text -> GVal m -> Maybe (GVal m)
lookupKey (forall (m :: * -> *). GVal m -> Text
asText GVal m
k) GVal m
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). Maybe Int -> GVal m -> Maybe (GVal m)
lookupIndexMay (forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber GVal m
k) GVal m
v

-- | Like 'lookupLoose', but fall back to the given default value if
-- the key is not in the dictionary, or if the indexee is not a
-- dictionary-like object.
lookupLooseDef :: GVal m -> GVal m -> GVal m -> GVal m
lookupLooseDef :: forall (m :: * -> *). GVal m -> GVal m -> GVal m -> GVal m
lookupLooseDef GVal m
d GVal m
k = forall a. a -> Maybe a -> a
fromMaybe GVal m
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> GVal m -> Maybe (GVal m)
lookupLoose GVal m
k

(~!) :: (FromGVal m v) => GVal m -> GVal m -> Maybe v
GVal m
g ~! :: forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
k = forall (m :: * -> *). GVal m -> GVal m -> Maybe (GVal m)
lookupLoose GVal m
k GVal m
g forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal

-- | Treat a 'GVal' as a dictionary and list all the keys, with no particular
-- ordering.
keys :: GVal m -> Maybe [Text]
keys :: forall (m :: * -> *). GVal m -> Maybe [Text]
keys GVal m
v = forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GVal m -> Maybe [(Text, GVal m)]
asDictItems GVal m
v

-- | Convert a 'GVal' to a number.
toNumber :: GVal m -> Maybe Scientific
toNumber :: forall (m :: * -> *). GVal m -> Maybe Scientific
toNumber = forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber

-- | Convert a 'GVal' to an 'Int'.
-- The conversion will fail when the value is not numeric, and also if
-- it is too large to fit in an 'Int'.
toInt :: GVal m -> Maybe Int
toInt :: forall (m :: * -> *). GVal m -> Maybe Int
toInt = forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). GVal m -> Maybe Scientific
toNumber

-- | Convert a 'GVal' to an 'Integer'
-- The conversion will fail when the value is not an integer
toInteger :: GVal m -> Maybe Integer
toInteger :: forall (m :: * -> *). GVal m -> Maybe Integer
toInteger = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber

-- | Convert a 'GVal' to an 'Int', falling back to the given
-- default if the conversion fails.
toIntDef :: Int -> GVal m -> Int
toIntDef :: forall (m :: * -> *). Int -> GVal m -> Int
toIntDef Int
d = forall a. a -> Maybe a -> a
fromMaybe Int
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe Int
toInt

-- | Convert a 'GVal' to an 'Int', falling back to zero (0)
-- if the conversion fails.
toInt0 :: GVal m -> Int
toInt0 :: forall (m :: * -> *). GVal m -> Int
toInt0 = forall (m :: * -> *). Int -> GVal m -> Int
toIntDef Int
0

-- | Loose cast to boolean.
--
-- Numeric zero, empty strings, empty lists, empty objects, 'Null', and boolean
-- 'False' are considered falsy, anything else (including functions) is
-- considered true-ish.
toBoolean :: GVal m -> Bool
toBoolean :: forall (m :: * -> *). GVal m -> Bool
toBoolean = forall (m :: * -> *). GVal m -> Bool
asBoolean

-- | Dynamically cast to a function.
-- This yields 'Just' a 'Function' if the value is a function, 'Nothing' if
-- it's not.
toFunction :: GVal m -> Maybe (Function m)
toFunction :: forall (m :: * -> *). GVal m -> Maybe (Function m)
toFunction = forall (m :: * -> *). GVal m -> Maybe (Function m)
asFunction

picoToScientific :: Pico -> Scientific
picoToScientific :: Pico -> Scientific
picoToScientific (MkFixed Integer
x) = Integer -> Int -> Scientific
scientific Integer
x (-Int
12)

scientificToPico :: Scientific -> Pico
scientificToPico :: Scientific -> Pico
scientificToPico Scientific
s =
    forall k (a :: k). Integer -> Fixed a
MkFixed (forall a b. (RealFrac a, Integral b) => a -> b
Prelude.floor forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (Scientific -> Integer
coefficient Scientific
s) (Scientific -> Int
base10Exponent Scientific
s forall a. Num a => a -> a -> a
+ Int
12))

{-#RULES "GVal/round-trip-Maybe" fromGVal . toGVal = Just #-}
{-#RULES "GVal/round-trip-Either" fromGValEither . toGVal = Right #-}
{-#RULES "GVal/text-shortcut" asText . toGVal = id #-}

class FromGVal m a where
    fromGValEither :: GVal m -> Either Prelude.String a
    fromGValEither = forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (forall a b. a -> Either a b
Left String
"Conversion from GVal failed") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal
    fromGVal :: GVal m -> Maybe a
    fromGVal = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. FromGVal m a => GVal m -> Either String a
fromGValEither

fromGValM :: (MonadFail m, FromGVal m a) => GVal m -> m a
fromGValM :: forall (m :: * -> *) a.
(MonadFail m, FromGVal m a) =>
GVal m -> m a
fromGValM = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. FromGVal m a => GVal m -> Either String a
fromGValEither

instance FromGVal m Int where
    fromGVal :: GVal m -> Maybe Int
fromGVal = forall (m :: * -> *). GVal m -> Maybe Int
toInt

instance FromGVal m Scientific where
    fromGVal :: GVal m -> Maybe Scientific
fromGVal = forall (m :: * -> *). GVal m -> Maybe Scientific
asNumber

instance FromGVal m Integer where
    fromGVal :: GVal m -> Maybe Integer
fromGVal = forall (m :: * -> *). GVal m -> Maybe Integer
toInteger

instance FromGVal m Text where
    fromGVal :: GVal m -> Maybe Text
fromGVal = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Text
asText

instance FromGVal m (GVal m) where
    fromGVal :: GVal m -> Maybe (GVal m)
fromGVal = forall a. a -> Maybe a
Just

instance FromGVal m ByteString where
    fromGVal :: GVal m -> Maybe ByteString
fromGVal = forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes

instance FromGVal m LBS.ByteString where
    fromGVal :: GVal m -> Maybe ByteString
fromGVal = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LBS.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes

instance FromGVal m a => FromGVal m (Maybe a) where
    fromGVal :: GVal m -> Maybe (Maybe a)
fromGVal = \GVal m
g ->
        if forall (m :: * -> *). GVal m -> Bool
isNull GVal m
g
            then
                forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
            else
                forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
g

instance FromGVal m Bool where
    fromGVal :: GVal m -> Maybe Bool
fromGVal = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GVal m -> Bool
asBoolean

instance FromGVal m JSON.Value where
    fromGVal :: GVal m -> Maybe Value
fromGVal = forall (m :: * -> *). GVal m -> Maybe Value
asJSON

instance FromGVal m () where
    fromGVal :: GVal m -> Maybe ()
fromGVal GVal m
g = if forall (m :: * -> *). GVal m -> Bool
isNull GVal m
g then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing

instance FromGVal m a => FromGVal m [a] where
    fromGVal :: GVal m -> Maybe [a]
fromGVal GVal m
g = forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal

instance ( FromGVal m a
         , FromGVal m b
         ) => FromGVal m (a, b) where
    fromGVal :: GVal m -> Maybe (a, b)
fromGVal GVal m
g = case forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g of
        Just [GVal m
a, GVal m
b] ->
            (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
a
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
b
        Maybe [GVal m]
_ -> forall a. Maybe a
Nothing

instance ( FromGVal m a
         , FromGVal m b
         , FromGVal m c
         ) => FromGVal m (a, b, c) where
    fromGVal :: GVal m -> Maybe (a, b, c)
fromGVal GVal m
g = case forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g of
        Just [GVal m
a, GVal m
b, GVal m
c] ->
            (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
a
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
b
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
c
        Maybe [GVal m]
_ -> forall a. Maybe a
Nothing

instance ( FromGVal m a
         , FromGVal m b
         , FromGVal m c
         , FromGVal m d
         ) => FromGVal m (a, b, c, d) where
    fromGVal :: GVal m -> Maybe (a, b, c, d)
fromGVal GVal m
g = case forall (m :: * -> *). GVal m -> Maybe [GVal m]
asList GVal m
g of
        Just [GVal m
a, GVal m
b, GVal m
c, GVal m
d] ->
            (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
a
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
b
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
c
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
d
        Maybe [GVal m]
_ -> forall a. Maybe a
Nothing

instance FromGVal m Day where
    fromGVal :: GVal m -> Maybe Day
fromGVal GVal m
g = do
        Integer
year <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"year" :: Maybe Int)
        Int
month <- GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"month"
        Int
day <- GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"day"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day

instance FromGVal m TimeOfDay where
    fromGVal :: GVal m -> Maybe TimeOfDay
fromGVal GVal m
g = do
        Int
hours <- GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"hours"
        Int
minutes <- GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"minutes"
        Pico
seconds <- Scientific -> Pico
scientificToPico forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"seconds"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hours Int
minutes Pico
seconds

instance FromGVal m LocalTime where
    fromGVal :: GVal m -> Maybe LocalTime
fromGVal GVal m
g = do
        Day
date <- forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
g forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"date"
        TimeOfDay
time <- forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
g forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"time"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
date TimeOfDay
time

instance FromGVal m ZonedTime where
    fromGVal :: GVal m -> Maybe ZonedTime
fromGVal GVal m
g = do
        LocalTime
localTime <- forall (m :: * -> *) a. FromGVal m a => GVal m -> Maybe a
fromGVal GVal m
g
        TimeZone
timeZone <- GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"tz"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
localTime TimeZone
timeZone

instance FromGVal m TimeZone where
    fromGVal :: GVal m -> Maybe TimeZone
fromGVal GVal m
g =
        Int -> Bool -> String -> TimeZone
TimeZone
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"minutes"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"summerOnly"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"name")

instance FromGVal m TimeLocale where
    fromGVal :: GVal m -> Maybe TimeLocale
fromGVal GVal m
g =
        if forall (m :: * -> *). GVal m -> Bool
isDict GVal m
g
            then
                forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [(String, String)]
-> [(String, String)]
-> (String, String)
-> String
-> String
-> String
-> String
-> [TimeZone]
-> TimeLocale
TimeLocale
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> [(String, String)]
wDays TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
List.map (Text, Text) -> (String, String)
unpackPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"wDays")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> [(String, String)]
months TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
List.map (Text, Text) -> (String, String)
unpackPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"months")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> (String, String)
amPm TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ (Text, Text) -> (String, String)
unpackPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"amPm")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> String
dateTimeFmt TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"dateTimeFmt")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> String
dateFmt TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"dateFmt")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> String
timeFmt TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"timeFmt")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> String
time12Fmt TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"time12Fmt")
                    (forall a. a -> Maybe a -> a
fromMaybe (TimeLocale -> [TimeZone]
knownTimeZones TimeLocale
defaultTimeLocale) forall a b. (a -> b) -> a -> b
$ GVal m
g forall (m :: * -> *) v. FromGVal m v => GVal m -> GVal m -> Maybe v
~! GVal m
"knownTimeZones")
            else
                forall a. Maybe a
Nothing

pairwise :: (a -> b) -> (a, a) -> (b, b)
pairwise :: forall a b. (a -> b) -> (a, a) -> (b, b)
pairwise a -> b
f (a
a, a
b) = (a -> b
f a
a, a -> b
f a
b)

packPair :: ([Char], [Char]) -> (Text, Text)
packPair :: (String, String) -> (Text, Text)
packPair = forall a b. (a -> b) -> (a, a) -> (b, b)
pairwise String -> Text
Text.pack

unpackPair :: (Text, Text) -> ([Char], [Char])
unpackPair :: (Text, Text) -> (String, String)
unpackPair = forall a b. (a -> b) -> (a, a) -> (b, b)
pairwise Text -> String
Text.unpack