module Text.JSON.Gen (
module Text.JSON.ToJSValue
, JSONGen
, JSONGenT
, runJSONGen
, runJSONGenT
, value
, valueM
, object
, objects
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.State.Strict
import Control.Monad.Reader
import Control.Monad.Reader.Class
import Data.Foldable
import Data.Sequence as S
import Text.JSON
import Text.JSON.ToJSValue
import Text.JSON.JSValueContainer
type JSONGen = JSONGenT Identity
newtype JSONGenT m a = JSONGenT (StateT (Seq (String, JSValue)) m a)
deriving (Applicative, Functor, Monad, MonadTrans)
instance (Monad m) => MonadReader (Seq (String, JSValue)) (JSONGenT m) where
ask = JSONGenT (get)
local f (JSONGenT m) = JSONGenT $ do
s <- get
put (f s)
res <- m
put s
return res
instance MonadIO m => MonadIO (JSONGenT m) where
liftIO = JSONGenT . liftIO
runJSONGen :: JSONGen () -> JSValue
runJSONGen = runIdentity . runJSONGenT
runJSONGenT :: Monad m => JSONGenT m () -> m JSValue
runJSONGenT (JSONGenT f) = getJSValue `liftM` execStateT f S.empty
value :: (Monad m, ToJSValue a) => String -> a -> JSONGenT m ()
value name val = JSONGenT $ modify (|> (name, toJSValue val))
valueM :: (Monad m, ToJSValue a) => String -> m a -> JSONGenT m ()
valueM name mval = lift mval >>= value name
object :: Monad m => String -> JSONGenT m () -> JSONGenT m ()
object name json = JSONGenT $ do
val <- lift $ runJSONGenT json
modify (|> (name, toJSValue val))
objects :: Monad m => String -> [JSONGenT m ()] -> JSONGenT m ()
objects name jsons = JSONGenT $ do
val <- mapM (lift . runJSONGenT) jsons
modify (|> (name, toJSValue val))