json-togo 0.1.0.2 → 0.1.0.3

raw patch · 2 files changed

+47/−81 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• json-togo.cabal +1/−1
• src/Data/JSON/ToGo.hs +46/−80

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                json-togo-version:             0.1.0.2+version:             0.1.0.3 synopsis:            Effectful parsing of JSON documents -- description:          homepage:            https://github.com/srijs/haskell-json-togo

@@ -1,101 +1,67 @@-{-# LANGUAGE FlexibleInstances #-}- module Data.JSON.ToGo-  ( ValueT(..), toValueT-  , matchValueT, matchValueT_-  , parseValueT, parseValueT_+  ( ValueM(..)+  , applyV, applyV_+  , applyP, applyP_   ) where  import Data.JSON.ToGo.Parser  import Data.Aeson (Value(..))-import Data.Monoid (Monoid(..))+import Data.Monoid (Monoid) import Data.Scientific (Scientific) import Data.Text (Text) import qualified Data.Vector as V import qualified Data.HashMap.Strict as H -import Control.Applicative (Applicative, pure, (<*>)) import Control.Monad (MonadPlus, mzero, msum) import Control.Monad.Trans.Class (lift) -data ValueT m a-  = NullM   { matchNull   ::                      m a }-  | BoolM   { matchBool   :: Bool       ->        m a }-  | NumberM { matchNumber :: Scientific ->        m a }-  | StringM { matchString :: Text       ->        m a }-  | ArrayM  { matchArray  :: Int        -> ValueT m a }-  | ObjectM { matchText   :: Text       -> ValueT m a }-  | AnyM    { matchAny    :: Value      ->        m a }-  | NoneM--toValueT :: Monad m => Value -> ValueT m Bool-toValueT Null       = NullM   $ return True-toValueT (Bool b)   = BoolM   $ return . (b ==)-toValueT (Number n) = NumberM $ return . (n ==)-toValueT (String s) = StringM $ return . (s ==)-toValueT (Array v)  = ArrayM  $ maybe NoneM toValueT . ((V.!?) v)-toValueT (Object h) = ObjectM $ maybe NoneM toValueT . (flip H.lookup h)+data ValueM m a+  = NullM   (m a)+  | BoolM   (Bool -> m a)+  | NumberM (Scientific -> m a)+  | StringM (Text -> m a)+  | ArrayM  (Int -> ValueM m a)+  | ObjectM (Text -> ValueM m a)+  | AnyM    (Value -> m a) -instance Monad m => Functor (ValueT m) where-  fmap g (NullM a)   = NullM   $         a >>= return . g-  fmap g (BoolM f)   = BoolM   $ \b -> f b >>= return . g-  fmap g (NumberM f) = NumberM $ \n -> f n >>= return . g-  fmap g (StringM f) = StringM $ \s -> f s >>= return . g+instance Monad m => Functor (ValueM m) where+  fmap g (NullM ma)  = NullM   $ ma >>= return.g+  fmap g (BoolM f)   = BoolM   $ fmap (>>= return.g) f+  fmap g (NumberM f) = NumberM $ fmap (>>= return.g) f+  fmap g (StringM f) = StringM $ fmap (>>= return.g) f   fmap g (ArrayM f)  = ArrayM  $ fmap (fmap g) f   fmap g (ObjectM f) = ObjectM $ fmap (fmap g) f-  fmap g (AnyM f)    = AnyM    $ \v -> f v >>= return . g-  fmap g NoneM       = NoneM--instance Monad m => Applicative (ValueT m) where-  pure = NullM . return-  (<*>) = apply--apply :: Monad m => ValueT m (a -> b) -> ValueT m a -> ValueT m b-apply (NullM g)   (NullM a)   = NullM   $ g >>= \g' -> a >>= return.g'-apply (BoolM g)   (BoolM f)   = BoolM   $ \b -> g b >>= \g' -> f b >>= return.g'-apply (NumberM g) (NumberM f) = NumberM $ \n -> g n >>= \g' -> f n >>= return.g'-apply (StringM g) (StringM f) = StringM $ \s -> g s >>= \g' -> f s >>= return.g'-apply (ArrayM g)  (ArrayM f)  = ArrayM  $ \i -> apply (g i) (f i)-apply (ObjectM g) (ObjectM f) = ObjectM $ \k -> apply (g k) (f k)-apply (AnyM g)    (AnyM f)    = AnyM    $ \v -> g v >>= \g' -> f v >>= return.g'-apply (AnyM g)    (NullM a)   = NullM   $ g Null >>= \g' -> a >>= return.g'-apply (AnyM g)    (BoolM f)   = BoolM   $ \b -> g (Bool b) >>= \g' -> f b >>= return.g'-apply (AnyM g)    (NumberM f) = NumberM $ \n -> g (Number n) >>= \g' -> f n >>= return.g'-apply (AnyM g)    (StringM f) = StringM $ \s -> g (String s) >>= \g' -> f s >>= return.g'-apply (AnyM g)    (ArrayM f)  = ArrayM  $ \i -> apply (AnyM g) (f i)-apply (AnyM g)    (ObjectM f) = ObjectM $ \k -> apply (AnyM g) (f k)-apply _           _           = NoneM+  fmap g (AnyM f)    = AnyM    $ fmap (>>= return.g) f -matchValueT :: MonadPlus m => ValueT m a -> Value -> m a-matchValueT (NullM ma)  Null       = ma-matchValueT (BoolM f)   (Bool b)   = f b-matchValueT (NumberM f) (Number n) = f n-matchValueT (StringM f) (String s) = f s-matchValueT (ArrayM f)  (Array v)  = msum $ map (uncurry (matchValueT . f)) (V.toList $ V.indexed v)-matchValueT (ObjectM f) (Object h) = msum $ map (uncurry (matchValueT . f)) (H.toList h)-matchValueT (AnyM f)    v          = f v-matchValueT _           _          = mzero+applyV :: MonadPlus m => ValueM m a -> Value -> m a+applyV (NullM ma)  Null       = ma+applyV (BoolM f)   (Bool b)   = f b+applyV (NumberM f) (Number n) = f n+applyV (StringM f) (String s) = f s+applyV (ArrayM f)  (Array v)  = msum $ map (uncurry (applyV . f)) (V.toList $ V.indexed v)+applyV (ObjectM f) (Object h) = msum $ map (uncurry (applyV . f)) (H.toList h)+applyV (AnyM f)    v          = f v+applyV _           _          = mzero -matchValueT_ :: Monad m => ValueT m a -> Value -> m ()-matchValueT_ (NullM ma)  Null         = ma >> return ()-matchValueT_ (BoolM f)   (Bool b)     = f b >> return ()-matchValueT_ (NumberM f) (Number n)   = f n >> return ()-matchValueT_ (StringM f) (String s)   = f s >> return ()-matchValueT_ (ArrayM f)  (Array v)    = mapM_ (uncurry (matchValueT_ . f)) (V.toList $ V.indexed v)-matchValueT_ (ObjectM f) (Object ias) = mapM_ (uncurry (matchValueT_ . f)) (H.toList ias)-matchValueT_ (AnyM f)    v            = f v >> return ()-matchValueT_ _           _            = return ()+applyV_ :: Monad m => ValueM m a -> Value -> m ()+applyV_ (NullM ma)  Null         = ma >> return ()+applyV_ (BoolM f)   (Bool b)     = f b >> return ()+applyV_ (NumberM f) (Number n)   = f n >> return ()+applyV_ (StringM f) (String s)   = f s >> return ()+applyV_ (ArrayM f)  (Array v)    = mapM_ (uncurry (applyV_ . f)) (V.toList $ V.indexed v)+applyV_ (ObjectM f) (Object ias) = mapM_ (uncurry (applyV_ . f)) (H.toList ias)+applyV_ (AnyM f)    v            = f v >> return ()+applyV_ _           _            = return () -parseValueT :: (Monad m, Monoid r) => ValueT m r -> ParserM m r-parseValueT (ArrayM f)  = parray  (parseValueT.f)-parseValueT (ObjectM f) = pobject (parseValueT.f)-parseValueT (NullM m)   = pbool   >>  lift m-parseValueT (BoolM f)   = pbool   >>= lift.f-parseValueT (NumberM f) = pnumber >>= lift.f-parseValueT (StringM f) = pstring >>= lift.f-parseValueT (AnyM f)    = pvalue  >>= lift.f-parseValueT NoneM       = fail "none"+applyP :: (Monad m, Monoid r) => ValueM m r -> ParserM m r+applyP (ArrayM f)  = parray  (applyP.f)+applyP (ObjectM f) = pobject (applyP.f)+applyP (NullM m)   = pbool   >>  lift m+applyP (BoolM f)   = pbool   >>= lift.f+applyP (NumberM f) = pnumber >>= lift.f+applyP (StringM f) = pstring >>= lift.f+applyP (AnyM f)    = pvalue  >>= lift.f -parseValueT_ :: Monad m => ValueT m a -> ParserM m ()-parseValueT_ = parseValueT . fmap (const ())+applyP_ :: Monad m => ValueM m a -> ParserM m ()+applyP_ = applyP . fmap (const ())