{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Toml.Types
( Table
, emptyTable
, VTArray
, VArray
, Node (..)
, Explicitness (..)
, isExplicit
, insert
, ToJSON (..)
, ToBsJSON (..)
) where
import Control.Monad (when)
import Text.Parsec
import Data.Aeson.Types
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
#endif
import Data.Int (Int64)
import Data.List (intersect)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Data.Time.Format ()
import Data.Vector (Vector)
import qualified Data.Vector as V
type Table = HashMap Text Node
emptyTable :: Table
emptyTable :: Table
emptyTable = Table
forall k v. HashMap k v
M.empty
type VTArray = Vector Table
type VArray = Vector Node
data Node = VTable !Table
| VTArray !VTArray
| VString !Text
| VInteger !Int64
| VFloat !Double
| VBoolean !Bool
| VDatetime !UTCTime
| VArray !VArray
deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show)
data Explicitness = Explicit | Implicit
deriving (Explicitness -> Explicitness -> Bool
(Explicitness -> Explicitness -> Bool)
-> (Explicitness -> Explicitness -> Bool) -> Eq Explicitness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Explicitness -> Explicitness -> Bool
== :: Explicitness -> Explicitness -> Bool
$c/= :: Explicitness -> Explicitness -> Bool
/= :: Explicitness -> Explicitness -> Bool
Eq, Int -> Explicitness -> ShowS
[Explicitness] -> ShowS
Explicitness -> String
(Int -> Explicitness -> ShowS)
-> (Explicitness -> String)
-> ([Explicitness] -> ShowS)
-> Show Explicitness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Explicitness -> ShowS
showsPrec :: Int -> Explicitness -> ShowS
$cshow :: Explicitness -> String
show :: Explicitness -> String
$cshowList :: [Explicitness] -> ShowS
showList :: [Explicitness] -> ShowS
Show)
isExplicit :: Explicitness -> Bool
isExplicit :: Explicitness -> Bool
isExplicit Explicitness
Explicit = Bool
True
isExplicit Explicitness
Implicit = Bool
False
insert :: Explicitness -> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert :: Explicitness
-> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert Explicitness
_ ([], Node
_) Table
_ = String -> Parsec Text (Set [Text]) Table
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"FATAL: Cannot call 'insert' without a name."
insert Explicitness
ex ([Text
name], Node
node) Table
ttbl =
case Text -> Table -> Maybe Node
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name Table
ttbl of
Maybe Node
Nothing -> do Bool
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Explicitness -> Bool
isExplicit Explicitness
ex) (ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ())
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExState [Text
name] Node
node
Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name Node
node Table
ttbl
Just (VTable Table
t) -> case Node
node of
(VTable Table
nt) -> case Table -> Table -> Either [Text] Table
merge Table
t Table
nt of
Left [Text]
ds -> [Text] -> Text -> Parsec Text (Set [Text]) Table
forall a. [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError [Text]
ds Text
name
Right Table
r -> do Bool
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Explicitness -> Bool
isExplicit Explicitness
ex) (ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ())
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExStateOrError [Text
name] Node
node
Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (Table -> Node
VTable Table
r) Table
ttbl
Node
_ -> Node -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
Just (VTArray VTArray
a) -> case Node
node of
(VTArray VTArray
na) -> Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (VTArray -> Node
VTArray (VTArray -> Node) -> VTArray -> Node
forall a b. (a -> b) -> a -> b
$ VTArray
a VTArray -> VTArray -> VTArray
forall a. Vector a -> Vector a -> Vector a
V.++ VTArray
na) Table
ttbl
Node
_ -> Node -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
Just Node
_ -> Node -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
insert Explicitness
ex (fullName :: [Text]
fullName@(Text
name:[Text]
ns), Node
node) Table
ttbl =
case Text -> Table -> Maybe Node
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name Table
ttbl of
Maybe Node
Nothing -> do
Table
r <- Explicitness
-> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert Explicitness
Implicit ([Text]
ns, Node
node) Table
emptyTable
Bool
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Explicitness -> Bool
isExplicit Explicitness
ex) (ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ())
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExState [Text]
fullName Node
node
Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (Table -> Node
VTable Table
r) Table
ttbl
Just (VTable Table
t) -> do
Table
r <- Explicitness
-> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert Explicitness
Implicit ([Text]
ns, Node
node) Table
t
Bool
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Explicitness -> Bool
isExplicit Explicitness
ex) (ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ())
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExStateOrError [Text]
fullName Node
node
Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (Table -> Node
VTable Table
r) Table
ttbl
Just (VTArray VTArray
a) ->
if VTArray -> Bool
forall a. Vector a -> Bool
V.null VTArray
a
then String -> Parsec Text (Set [Text]) Table
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"FATAL: Call to 'insert' found impossibly empty VArray."
else do Table
r <- Explicitness
-> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert Explicitness
Implicit ([Text]
ns, Node
node) (VTArray -> Table
forall a. Vector a -> a
V.last VTArray
a)
Table -> Parsec Text (Set [Text]) Table
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Parsec Text (Set [Text]) Table)
-> Table -> Parsec Text (Set [Text]) Table
forall a b. (a -> b) -> a -> b
$ Text -> Node -> Table -> Table
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (VTArray -> Node
VTArray (VTArray -> Node) -> VTArray -> Node
forall a b. (a -> b) -> a -> b
$ (VTArray -> VTArray
forall a. Vector a -> Vector a
V.init VTArray
a) VTArray -> Table -> VTArray
forall a. Vector a -> a -> Vector a
`V.snoc` Table
r) Table
ttbl
Just Node
_ -> Node -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text]
fullName
merge :: Table -> Table -> Either [Text] Table
merge :: Table -> Table -> Either [Text] Table
merge Table
existing Table
new = case Table -> [Text]
forall k v. HashMap k v -> [k]
M.keys Table
existing [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Table -> [Text]
forall k v. HashMap k v -> [k]
M.keys Table
new of
[] -> Table -> Either [Text] Table
forall a b. b -> Either a b
Right (Table -> Either [Text] Table) -> Table -> Either [Text] Table
forall a b. (a -> b) -> a -> b
$ Table -> Table -> Table
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
M.union Table
existing Table
new
[Text]
ds -> [Text] -> Either [Text] Table
forall a b. a -> Either a b
Left ([Text] -> Either [Text] Table) -> [Text] -> Either [Text] Table
forall a b. (a -> b) -> a -> b
$ [Text]
ds
updateExStateOrError :: [Text] -> Node -> Parsec Text (Set [Text]) ()
updateExStateOrError :: [Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExStateOrError [Text]
name node :: Node
node@(VTable Table
_) = do
Set [Text]
explicitlyDefinedNames <- ParsecT Text (Set [Text]) Identity (Set [Text])
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text] -> Set [Text] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Text]
name Set [Text]
explicitlyDefinedNames) (ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ())
-> ParsecT Text (Set [Text]) Identity ()
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ParsecT Text (Set [Text]) Identity ()
forall a. [Text] -> Parsec Text (Set [Text]) a
tableClashError [Text]
name
[Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExState [Text]
name Node
node
updateExStateOrError [Text]
_ Node
_ = () -> ParsecT Text (Set [Text]) Identity ()
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateExState :: [Text] -> Node -> Parsec Text (S.Set [Text]) ()
updateExState :: [Text] -> Node -> ParsecT Text (Set [Text]) Identity ()
updateExState [Text]
name (VTable Table
_) = (Set [Text] -> Set [Text]) -> ParsecT Text (Set [Text]) Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((Set [Text] -> Set [Text])
-> ParsecT Text (Set [Text]) Identity ())
-> (Set [Text] -> Set [Text])
-> ParsecT Text (Set [Text]) Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Set [Text] -> Set [Text]
forall a. Ord a => a -> Set a -> Set a
S.insert [Text]
name
updateExState [Text]
_ Node
_ = () -> ParsecT Text (Set [Text]) Identity ()
forall a. a -> ParsecT Text (Set [Text]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nameInsertError :: [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError :: forall a. [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError [Text]
ns Text
name = String -> ParsecT Text (Set [Text]) Identity a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> ParsecT Text (Set [Text]) Identity a)
-> (Text -> String) -> Text -> ParsecT Text (Set [Text]) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ParsecT Text (Set [Text]) Identity a)
-> Text -> ParsecT Text (Set [Text]) Identity a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"Cannot redefine key(s) (", Text -> [Text] -> Text
T.intercalate Text
", " [Text]
ns
, Text
"), from table named '", Text
name, Text
"'." ]
tableClashError :: [Text] -> Parsec Text (Set [Text]) a
tableClashError :: forall a. [Text] -> Parsec Text (Set [Text]) a
tableClashError [Text]
name = String -> ParsecT Text (Set [Text]) Identity a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> ParsecT Text (Set [Text]) Identity a)
-> (Text -> String) -> Text -> ParsecT Text (Set [Text]) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ParsecT Text (Set [Text]) Identity a)
-> Text -> ParsecT Text (Set [Text]) Identity a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"Cannot redefine table named: '", Text -> [Text] -> Text
T.intercalate Text
"." [Text]
name, Text
"'." ]
commonInsertError :: Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError :: forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
what [Text]
name = String -> ParsecT Text (Set [Text]) Identity a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> ParsecT Text (Set [Text]) Identity a)
-> ([String] -> String)
-> [String]
-> ParsecT Text (Set [Text]) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> ParsecT Text (Set [Text]) Identity a)
-> [String] -> ParsecT Text (Set [Text]) Identity a
forall a b. (a -> b) -> a -> b
$
[ String
"Cannot insert ", String
w, String
" as '", String
n, String
"' since key already exists." ]
where
n :: String
n = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." [Text]
name
w :: String
w = case Node
what of (VTable Table
_) -> String
"tables"
Node
_ -> String
"array of tables"
instance ToJSON Node where
toJSON :: Node -> Value
toJSON (VTable Table
v) = Table -> Value
forall a. ToJSON a => a -> Value
toJSON Table
v
toJSON (VTArray VTArray
v) = VTArray -> Value
forall a. ToJSON a => a -> Value
toJSON VTArray
v
toJSON (VString Text
v) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v
toJSON (VInteger Int64
v) = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
v
toJSON (VFloat Double
v) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
v
toJSON (VBoolean Bool
v) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
v
toJSON (VDatetime UTCTime
v) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
v
toJSON (VArray VArray
v) = VArray -> Value
forall a. ToJSON a => a -> Value
toJSON VArray
v
class ToBsJSON a where
toBsJSON :: a -> Value
instance (ToBsJSON a) => ToBsJSON (Vector a) where
toBsJSON :: Vector a -> Value
toBsJSON = Array -> Value
Array (Array -> Value) -> (Vector a -> Array) -> Vector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON
{-# INLINE toBsJSON #-}
instance (ToBsJSON v) => ToBsJSON (M.HashMap Text v) where
#if MIN_VERSION_aeson(2,0,0)
toBsJSON :: HashMap Text v -> Value
toBsJSON = Object -> Value
Object (Object -> Value)
-> (HashMap Text v -> Object) -> HashMap Text v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> Object
forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText (HashMap Text Value -> Object)
-> (HashMap Text v -> HashMap Text Value)
-> HashMap Text v
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value) -> HashMap Text v -> HashMap Text Value
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map v -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON
#else
toBsJSON = Object . M.map toBsJSON
#endif
{-# INLINE toBsJSON #-}
#if MIN_VERSION_aeson(2,0,0)
instance (ToBsJSON v) => ToBsJSON (KM.KeyMap v) where
toBsJSON :: KeyMap v -> Value
toBsJSON = Object -> Value
Object (Object -> Value) -> (KeyMap v -> Object) -> KeyMap v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value) -> KeyMap v -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
KM.map v -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON
{-# INLINE toBsJSON #-}
#endif
instance ToBsJSON Node where
toBsJSON :: Node -> Value
toBsJSON (VTable Table
v) = Table -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON Table
v
toBsJSON (VTArray VTArray
v) = VTArray -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON VTArray
v
toBsJSON (VString Text
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"string" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v ]
toBsJSON (VInteger Int64
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"integer" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (Int64 -> String
forall a. Show a => a -> String
show Int64
v) ]
toBsJSON (VFloat Double
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"float" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> String
forall a. Show a => a -> String
show Double
v) ]
toBsJSON (VBoolean Bool
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"bool" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (if Bool
v then String
"true" else String
"false" :: String) ]
toBsJSON (VDatetime UTCTime
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"datetime" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (let s :: String
s = UTCTime -> String
forall a. Show a => a -> String
show UTCTime
v
z :: String
z = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Z"
d :: String
d = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10) String
z
t :: String
t = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9) String
z
in String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"T" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t) ]
toBsJSON (VArray VArray
v) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"array" :: String)
, Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VArray -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON VArray
v ]