{-# 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
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
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: 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
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> 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
/= :: Explicitness -> Explicitness -> Bool
$c/= :: Explicitness -> Explicitness -> Bool
== :: Explicitness -> Explicitness -> Bool
$c== :: 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
showList :: [Explicitness] -> ShowS
$cshowList :: [Explicitness] -> ShowS
show :: Explicitness -> String
$cshow :: Explicitness -> String
showsPrec :: Int -> Explicitness -> ShowS
$cshowsPrec :: Int -> Explicitness -> ShowS
Show)
isExplicit :: Explicitness -> Bool
isExplicit :: Explicitness -> Bool
isExplicit Explicit = Bool
True
isExplicit Implicit = Bool
False
insert :: Explicitness -> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert :: Explicitness
-> ([Text], Node) -> Table -> Parsec Text (Set [Text]) Table
insert _ ([], _) _ = String -> Parsec Text (Set [Text]) Table
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail "FATAL: Cannot call 'insert' without a name."
insert ex :: Explicitness
ex ([name :: Text
name], node :: Node
node) ttbl :: 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
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 (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 t :: Table
t) -> case Node
node of
(VTable nt :: Table
nt) -> case Table -> Table -> Either [Text] Table
merge Table
t Table
nt of
Left ds :: [Text]
ds -> [Text] -> Text -> Parsec Text (Set [Text]) Table
forall a. [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError [Text]
ds Text
name
Right r :: 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 (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 -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
Just (VTArray a :: VTArray
a) -> case Node
node of
(VTArray na :: VTArray
na) -> Table -> Parsec Text (Set [Text]) Table
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 -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
Just _ -> Node -> [Text] -> Parsec Text (Set [Text]) Table
forall a. Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError Node
node [Text
name]
insert ex :: Explicitness
ex (fullName :: [Text]
fullName@(name :: Text
name:ns :: [Text]
ns), node :: Node
node) ttbl :: 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
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 (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 t :: 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 (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 a :: 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 "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 (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 -> [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 existing :: Table
existing new :: 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, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union Table
existing Table
new
ds :: [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 name :: [Text]
name node :: Node
node@(VTable _) = 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 _ _ = () -> ParsecT Text (Set [Text]) Identity ()
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 name :: [Text]
name (VTable _) = (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 _ _ = () -> ParsecT Text (Set [Text]) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nameInsertError :: [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError :: [Text] -> Text -> Parsec Text (Set [Text]) a
nameInsertError ns :: [Text]
ns name :: Text
name = String -> Parsec Text (Set [Text]) a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> Parsec Text (Set [Text]) a)
-> (Text -> String) -> Text -> Parsec Text (Set [Text]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parsec Text (Set [Text]) a)
-> Text -> Parsec Text (Set [Text]) a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ "Cannot redefine key(s) (", Text -> [Text] -> Text
T.intercalate ", " [Text]
ns
, "), from table named '", Text
name, "'." ]
tableClashError :: [Text] -> Parsec Text (Set [Text]) a
tableClashError :: [Text] -> Parsec Text (Set [Text]) a
tableClashError name :: [Text]
name = String -> Parsec Text (Set [Text]) a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> Parsec Text (Set [Text]) a)
-> (Text -> String) -> Text -> Parsec Text (Set [Text]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parsec Text (Set [Text]) a)
-> Text -> Parsec Text (Set [Text]) a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ "Cannot redefine table named: '", Text -> [Text] -> Text
T.intercalate "." [Text]
name, "'." ]
commonInsertError :: Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError :: Node -> [Text] -> Parsec Text (Set [Text]) a
commonInsertError what :: Node
what name :: [Text]
name = String -> Parsec Text (Set [Text]) a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> Parsec Text (Set [Text]) a)
-> ([String] -> String) -> [String] -> Parsec Text (Set [Text]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> Parsec Text (Set [Text]) a)
-> [String] -> Parsec Text (Set [Text]) a
forall a b. (a -> b) -> a -> b
$
[ "Cannot insert ", String
w, " as '", String
n, "' 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]
name
w :: String
w = case Node
what of (VTable _) -> "tables"
_ -> "array of tables"
instance ToJSON Node where
toJSON :: Node -> Value
toJSON (VTable v :: Table
v) = Table -> Value
forall a. ToJSON a => a -> Value
toJSON Table
v
toJSON (VTArray v :: VTArray
v) = VTArray -> Value
forall a. ToJSON a => a -> Value
toJSON VTArray
v
toJSON (VString v :: Text
v) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v
toJSON (VInteger v :: Int64
v) = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
v
toJSON (VFloat v :: Double
v) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
v
toJSON (VBoolean v :: Bool
v) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
v
toJSON (VDatetime v :: UTCTime
v) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
v
toJSON (VArray v :: 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
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
. (v -> Value) -> HashMap Text v -> Object
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map v -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON
{-# INLINE toBsJSON #-}
instance ToBsJSON Node where
toBsJSON :: Node -> Value
toBsJSON (VTable v :: Table
v) = Table -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON Table
v
toBsJSON (VTArray v :: VTArray
v) = VTArray -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON VTArray
v
toBsJSON (VString v :: Text
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("string" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v ]
toBsJSON (VInteger v :: Int64
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("integer" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (Int64 -> String
forall a. Show a => a -> String
show Int64
v) ]
toBsJSON (VFloat v :: Double
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("float" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> String
forall a. Show a => a -> String
show Double
v) ]
toBsJSON (VBoolean v :: Bool
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("bool" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (if Bool
v then "true" else "false" :: String) ]
toBsJSON (VDatetime v :: UTCTime
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("datetime" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "Z"
d :: String
d = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- 10) String
z
t :: String
t = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- 9) String
z
in String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ "T" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t) ]
toBsJSON (VArray v :: VArray
v) = [Pair] -> Value
object [ "type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON ("array" :: String)
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VArray -> Value
forall a. ToBsJSON a => a -> Value
toBsJSON VArray
v ]