packages feed

aeson-value-parser (empty) → 0.9.0

raw patch · 4 files changed

+224/−0 lines, 4 filesdep +aesondep +base-preludedep +mtl-preludesetup-changed

Dependencies added: aeson, base-prelude, mtl-prelude, scientific, text, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Sannsyn AS++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
+ aeson-value-parser.cabal view
@@ -0,0 +1,56 @@+name:+  aeson-value-parser+version:+  0.9.0+synopsis:+  An API for parsing "aeson" JSON tree into Haskell types+description:+category:+  Data, JSON, Parsing+homepage:+  https://github.com/sannsyn/aeson-value-parser +bug-reports:+  https://github.com/sannsyn/aeson-value-parser/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Sannsyn AS+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/sannsyn/aeson-value-parser.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+  exposed-modules:+    Aeson.ValueParser+  build-depends:+    --+    aeson >= 0.8 && < 0.10,+    unordered-containers == 0.2.*,+    vector >= 0.10 && < 0.12,+    scientific == 0.3.*,+    text == 1.*,+    --+    mtl-prelude < 3,+    base-prelude >= 0.1.19 && < 0.2
+ library/Aeson/ValueParser.hs view
@@ -0,0 +1,144 @@+module Aeson.ValueParser+(+  ValueParser,+  ArrayParser,+  ObjectParser,+  run,+  -- * Value parsers+  onArray,+  onObject,+  onNullable,+  string,+  number,+  bool,+  fromJSON,+  -- * Object parsers+  onKey,+  onAllKeys,+  -- * Array parsers+  onIndex,+  onAllIndexes,+)+where++import BasePrelude hiding (bool)+import MTLPrelude+import Data.Text (Text)+import Data.Scientific (Scientific)+import qualified Data.Aeson as A+import qualified Data.HashMap.Strict as B+import qualified Data.Vector as C+++newtype Result a =+  Result { resultEither :: Either Text a }+  deriving (Functor, Applicative, Monad, MonadError Text)++instance Alternative Result where+  empty = +    Result $ Left "No result"+  (<|>) =+    \case+      Result (Left _) -> id+      r -> const r++instance MonadPlus Result where+  mzero = empty+  mplus = (<|>)+++type ValueParser =+  ReaderT A.Value Result++type ArrayParser =+  ReaderT A.Array Result++type ObjectParser =+  ReaderT A.Object Result++run :: ValueParser a -> A.Value -> Either Text a+run effect =+  resultEither . runReaderT effect++-- * Value parsers+-------------------------++onArray :: ArrayParser a -> ValueParser a+onArray effect =+  ReaderT $ \case+    A.Array x ->+      runReaderT effect x+    _ ->+      Result $ Left "Not an array"++onObject :: ObjectParser a -> ValueParser a+onObject effect =+  ReaderT $ \case+    A.Object x ->+      runReaderT effect x+    _ ->+      Result $ Left "Not an object"++onNullable :: ValueParser a -> ValueParser (Maybe a)+onNullable q =+  ReaderT $ \case+    A.Null ->+      return Nothing+    x -> +      Result $ fmap Just $ run q x++string :: ValueParser Text+string =+  ReaderT $ \case+    A.String t ->+      return t+    _ ->+      Result $ Left "Not a string"++number :: ValueParser Scientific+number =+  ReaderT $ \case+    A.Number x ->+      return x+    _ ->+      Result $ Left "Not a number"++bool :: ValueParser Bool+bool =+  ReaderT $ \case+    A.Bool x -> +      return x+    _ -> +      Result $ Left "Not a bool"++fromJSON :: A.FromJSON a => ValueParser a+fromJSON =+  ReaderT $ A.fromJSON >>> \case+    A.Error m -> Result $ Left $ fromString m+    A.Success r -> Result $ Right $ r++-- * Object parsers+-------------------------++onKey :: Text -> ValueParser a -> ObjectParser a+onKey key effect =+  ReaderT $+    maybe (Result $ Left $ "Object contains no field '" <> key <> "'") (runReaderT effect) .+    B.lookup key++onAllKeys :: ValueParser a -> ObjectParser (B.HashMap Text a)+onAllKeys effect =+  ReaderT $ mapM (runReaderT effect)++-- * Array parsers+-------------------------++onIndex :: Int -> ValueParser a -> ArrayParser a+onIndex index effect =+  ReaderT $ +    maybe (Result $ Left $ "Array has no index '" <> (fromString . show) index <> "'") (runReaderT effect) .+    flip (C.!?) index++onAllIndexes :: ValueParser a -> ArrayParser (C.Vector a)+onAllIndexes effect =+  ReaderT $ mapM (runReaderT effect)