json-togo 0.1.0.1 → 0.1.0.2

raw patch · 2 files changed

+82/−48 lines, 2 filesdep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

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

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                json-togo-version:             0.1.0.1+version:             0.1.0.2 synopsis:            Effectful parsing of JSON documents -- description:          homepage:            https://github.com/srijs/haskell-json-togo@@ -22,7 +22,7 @@   -- other-modules:          -- other-extensions:       build-depends:       base >=4.7 && <5.0,-                       transformers >=0.3 && <0.4,+                       transformers >=0.3 && <0.5,                        bytestring >=0.10 && <0.11,                        text >=1.2 && <1.3,                        scientific >=0.3 && <0.4,

@@ -1,67 +1,101 @@+{-# LANGUAGE FlexibleInstances #-}+ module Data.JSON.ToGo-  ( ValueM(..)-  , applyV, applyV_-  , applyP, applyP_+  ( ValueT(..), toValueT+  , matchValueT, matchValueT_+  , parseValueT, parseValueT_   ) 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 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)+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 -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+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)++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   fmap g (ArrayM f)  = ArrayM  $ fmap (fmap g) f   fmap g (ObjectM f) = ObjectM $ fmap (fmap g) f-  fmap g (AnyM f)    = AnyM    $ fmap (>>= return.g) f+  fmap g (AnyM f)    = AnyM    $ \v -> f v >>= return . g+  fmap g NoneM       = NoneM -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+instance Monad m => Applicative (ValueT m) where+  pure = NullM . return+  (<*>) = apply -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 ()+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 -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+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 -applyP_ :: Monad m => ValueM m a -> ParserM m ()-applyP_ = applyP . fmap (const ())+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 ()++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"++parseValueT_ :: Monad m => ValueT m a -> ParserM m ()+parseValueT_ = parseValueT . fmap (const ())