json-togo (empty) → 0.1.0.0

raw patch · 5 files changed

+190/−0 lines, 5 filesdep +aesondep +attoparsecdep +attoparsec-transsetup-changed

Dependencies added: aeson, attoparsec, attoparsec-trans, base, bytestring, scientific, text, transformers, unordered-containers, vector

Files

LICENSE +20/−0
Setup.hs +2/−0
json-togo.cabal +36/−0
src/Data/JSON/ToGo.hs +67/−0
src/Data/JSON/ToGo/Parser.hs +65/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Sam Rijs++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ json-togo.cabal view

@@ -0,0 +1,36 @@+-- Initial jsonap.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                json-togo+version:             0.1.0.0+synopsis:            Effectful parsing of JSON documents+-- description:         +homepage:            https://github.com/srijs/haskell-json-togo+license:             MIT+license-file:        LICENSE+author:              Sam Rijs+maintainer:          srijs@airpost.net+-- copyright:           +category:            Data+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Data.JSON.ToGo+                       Data.JSON.ToGo.Parser+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.7 && <5.0,+                       transformers >=0.3 && <0.4,+                       bytestring >=0.10 && <0.11,+                       text >=1.2 && <1.3,+                       scientific >=0.3 && <0.4,+                       aeson >=0.8 && <0.10,+                       attoparsec >=0.12 && <0.14,+                       attoparsec-trans >=0.1 && <0.2,+                       vector >=0.10 && <0.11,+                       unordered-containers >=0.2 && <0.3+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -fwarn-unused-imports

+ src/Data/JSON/ToGo.hs view

@@ -0,0 +1,67 @@+module Data.JSON.ToGo+  ( ValueM(..)+  , applyV, applyV_+  , applyP, applyP_+  ) where++import Data.JSON.ToGo.Parser++import Data.Aeson (Value(..))+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.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)++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    $ fmap (>>= return.g) f++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++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 ()++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++applyP_ :: Monad m => ValueM m a -> ParserM m ()+applyP_ = applyP . fmap (const ())

+ src/Data/JSON/ToGo/Parser.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings, RankNTypes #-}++module Data.JSON.ToGo.Parser where++import Prelude hiding (sequence)++import Data.Aeson.Parser (jstring, value)+import Data.Aeson.Types (Value)+import Data.Attoparsec.ByteString.Char8 (skipSpace, char, string, scientific, parse)+import Data.ByteString (ByteString)+import Data.Monoid (Monoid, mempty, (<>))+import Data.Scientific (Scientific)+import Data.Text (Text)++import Control.Applicative ((<$), (<*), (<|>))+import Control.Monad (join)+import Control.Monad.Trans.Parser (ParserT, liftP)++type ParserM = ParserT ByteString++rP p = liftP . parse $ skipSpace >> p++parray :: (Monad m, Monoid r) => (Int -> ParserM m r) -> ParserM m r+parray f = rP (char '[') >> go 0 mempty+  where+    go idx r = do+      r' <- f idx+      join $ rP $+        (go (succ idx) (r <> r') <$ char ',') <|> (return (r <> r') <$ char ']')++pobject :: (Monad m, Monoid r) => (Text -> ParserM m r) -> ParserM m r+pobject f = rP (char '{') >> go mempty+  where+    go r = do+      key <- rP $ jstring <* (skipSpace >> char ':')+      r' <- f key+      join $ rP $+        (go (r <> r') <$ char ',') <|> (return (r <> r') <$ char '}')++parrayL :: Monad m => (Int -> ParserM m r) -> ParserM m [r]+parrayL = parray . fmap (fmap (:[]))++pobjectL :: Monad m => (Text -> ParserM m r) -> ParserM m [r]+pobjectL = pobject . fmap (fmap (:[]))++parray_ :: Monad m => (Int -> ParserM m r) -> ParserM m ()+parray_ = parray . fmap (fmap (const ()))++pobject_ :: Monad m => (Text -> ParserM m r) -> ParserM m ()+pobject_ = pobject . fmap (fmap (const ()))++pnull :: Monad m => ParserM m ()+pnull = rP $ () <$ string "null"++pbool :: Monad m => ParserM m Bool+pbool = rP $ False <$ string "false" <|> True <$ string "true"++pnumber :: Monad m => ParserM m Scientific+pnumber = rP scientific++pstring :: Monad m => ParserM m Text+pstring = rP jstring++pvalue :: Monad m => ParserM m Value+pvalue = rP value