aeson-applicative (empty) → 0.1.0.0

raw patch · 4 files changed

+123/−0 lines, 4 filesdep +aesondep +basedep +textsetup-changed

Dependencies added: aeson, base, text, unordered-containers

Files

• Data/Aeson/JsonInfo.hs +83/−0
• LICENSE +20/−0
• Setup.hs +2/−0
• aeson-applicative.cabal +18/−0

@@ -0,0 +1,83 @@+{-# LANGUAGE LambdaCase, GADTs, FlexibleContexts, ScopedTypeVariables #-}+module Data.Aeson.JsonInfo where++import Control.Applicative+import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text, unpack)+import qualified Data.HashMap.Strict as HM+import Data.Monoid ((<>))+import Data.Typeable (Typeable, typeRep)+import Data.Proxy (Proxy(..))++type JsonInfo a = JsonFieldInfo a a++-- | 'JsonFieldInfo'+--+-- Use the 'JsonInfo' type alias instead+--+-- > Data R = R { a :: Text, b :: Int32 } deriving Typeable+-- >+-- > rJsonInfo :: JsonInfo R+-- > rJsonInfo = R+-- >         <$> "a" @: a+-- >         <*> 'b  @: b+-- >+-- > instance ToJSON R where+-- >   toJSON = jiToJSON rJsonInfo+-- > instance FromJSON R where+-- >   parseJSON = jiParseJSON rJsonInfo+data JsonFieldInfo t a where+  Pure :: a -> JsonFieldInfo t a+  Map :: (a -> b) -> JsonFieldInfo t a -> JsonFieldInfo t b+  App :: JsonFieldInfo t (a -> b) -> JsonFieldInfo t a -> JsonFieldInfo t b+  Field :: (ToJSON a, FromJSON a)+        => (t -> a) -- ^ the accessor+        -> Text -- ^ name in the json object+        -> Maybe a -- ^ default value+        -> JsonFieldInfo t a++instance Functor (JsonFieldInfo t) where+  fmap = Map++instance Applicative (JsonFieldInfo t) where+  pure = Pure+  (<*>) = App++fieldJInfo, (@:) :: (ToJSON a, FromJSON a) => Text -> (t -> a) -> JsonFieldInfo t a+fieldJInfo name accessor = Field accessor name Nothing+(@:) = fieldJInfo++fieldJInfoOpt, (@:?) :: (ToJSON (Maybe a), FromJSON (Maybe a)) => Text -> (t -> Maybe a) -> JsonFieldInfo t (Maybe a)+fieldJInfoOpt name accessor = Field accessor name (Just Nothing)+(@:?) = fieldJInfoOpt++jiToJSON :: JsonInfo t -> t -> Value+jiToJSON ji = Object . jiToObject ji++jiToObject :: forall t. JsonInfo t -> t -> Object+jiToObject ji t = mkObj ji HM.empty+  where+    mkObj :: JsonFieldInfo t a -> Object -> Object+    mkObj = \case+      Pure _ -> id+      Map _ x -> mkObj x+      App x y -> mkObj x . mkObj y+      Field accessor name _ -> HM.insert name . toJSON $ accessor t++jiParseJSON :: Typeable t => JsonInfo t -> Value -> Parser t+jiParseJSON (ji :: JsonInfo t) =+    withObject (show $ typeRep (Proxy :: Proxy t))+  $ jiFromObject ji++jiFromObject :: forall t. JsonInfo t -> Object -> Parser t+jiFromObject ji o = go ji+  where+    go :: forall a. JsonFieldInfo t a -> Parser a+    go = \case+      Pure x -> pure x+      Map f x -> f <$> go x+      App x y -> go x <*> go y+      Field _ name def -> case HM.lookup name o of+          Just v -> parseJSON v+          Nothing -> maybe (fail $ "key " <> unpack name <> " not present") return def

@@ -0,0 +1,20 @@+Copyright (c) 2015 Greg Weber++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.

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

@@ -0,0 +1,18 @@+name:                aeson-applicative+version:             0.1.0.0+synopsis:            make To/From JSOn instances from an applicative description+homepage:            https://github.com/gregwebs/aeson-applicative-dsl+license:             MIT+license-file:        LICENSE+author:              Greg Weber+maintainer:          greg@gregweber.info+category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.Aeson.JsonInfo+  build-depends:       base >=4.7 && <4.8, aeson, unordered-containers, text+  default-language:    Haskell2010+  default-extensions: LambdaCase+  ghc-options: -Wall