packages feed

jsop 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+483/−272 lines, 9 filesdep +unordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: unordered-containers

API changes (from Hackage documentation)

- JSOP.Example: ABC :: Text -> Int -> Int -> ABC
- JSOP.Example: abc :: ABC
- JSOP.Example: cherryPickABC :: NP (Parser Text) '[Text, Int, Int]
- JSOP.Example: data ABC
- JSOP.Example: instance GHC.Classes.Eq JSOP.Example.ABC
- JSOP.Example: instance GHC.Show.Show JSOP.Example.ABC
- JSOP.Example: instance Generics.SOP.Universe.Generic JSOP.Example.ABC
- JSOP.Example: instance Generics.SOP.Universe.HasDatatypeInfo JSOP.Example.ABC
- JSOP.Example: jsonWithABC :: Value
- JSOP.Parse: ParseGIssue :: (Int, Maybe Value, TypeRep) -> ParseGIssue
- JSOP.Parse: ParseGWrongNumberOfValues :: ParseGIssue
- JSOP.Parse: Parser :: p -> Maybe a -> Preview a -> Parser p a
- JSOP.Parse: [parser_default] :: Parser p a -> Maybe a
- JSOP.Parse: [parser_path] :: Parser p a -> p
- JSOP.Parse: [parser_prism] :: Parser p a -> Preview a
- JSOP.Parse: data ParseGIssue
- JSOP.Parse: data Parser p a
- JSOP.Parse: getValues :: (p -> [Text]) -> [p] -> Value -> [Maybe Value]
- JSOP.Parse: instance GHC.Classes.Eq JSOP.Parse.ParseGIssue
- JSOP.Parse: instance GHC.Show.Show JSOP.Parse.ParseGIssue
- JSOP.Parse: jSOP :: (All Typeable xs, IsProductType a xs) => (path -> [Text]) -> NP (Parser path) xs -> Value -> Either ParseGIssue a
- JSOP.Parse: mkPath :: Int -> [Text] -> Paths
- JSOP.Parse: mkPaths :: [[Text]] -> Paths
- JSOP.Parse: optional :: p -> a -> Preview a -> Parser p a
- JSOP.Parse: parseSField :: forall a p. Typeable a => Parser p a -> K (Int, Maybe Value) a -> Either ParseGIssue a
- JSOP.Parse: required :: p -> Preview a -> Parser p a
- JSOP.Parse: treequery :: Paths -> Value -> ([(Int, Value)], [Int])
- JSOP.Parse: type Paths = Trie Text (First Int, [Int])
- JSOP.Parse: type Preview a = Getting (First a) Value a
+ Data.JSOP: JSOP :: p -> Maybe a -> ValuePrism a -> JSOP p a
+ Data.JSOP: JSOPIssue :: (Int, Maybe Value, TypeRep) -> JSOPIssue
+ Data.JSOP: JSOPWrongNumberOfPaths :: JSOPIssue
+ Data.JSOP: [jsop_default] :: JSOP p a -> Maybe a
+ Data.JSOP: [jsop_path] :: JSOP p a -> p
+ Data.JSOP: [jsop_prism] :: JSOP p a -> ValuePrism a
+ Data.JSOP: data JSOP p a
+ Data.JSOP: data JSOPIssue
+ Data.JSOP: getValues :: (p -> [Text]) -> [p] -> Value -> [Maybe Value]
+ Data.JSOP: instance GHC.Classes.Eq Data.JSOP.JSOPIssue
+ Data.JSOP: instance GHC.Show.Show Data.JSOP.JSOPIssue
+ Data.JSOP: jread :: (All Typeable xs, IsProductType a xs) => (path -> [Text]) -> NP (JSOP path) xs -> Value -> Either JSOPIssue a
+ Data.JSOP: jwrite :: (All Typeable xs, IsProductType a xs, All Top xs, Show path, Ord path) => (path -> [Text]) -> NP (JSOP path) xs -> Value -> a -> Value
+ Data.JSOP: mkPath :: Int -> [Text] -> QPaths
+ Data.JSOP: mkPaths :: [[Text]] -> QPaths
+ Data.JSOP: mkTPath :: Int -> (Bool, [Text]) -> TPaths
+ Data.JSOP: mkTPaths :: [(Bool, [Text])] -> TPaths
+ Data.JSOP: optional :: p -> a -> ValuePrism a -> JSOP p a
+ Data.JSOP: parseSField :: forall a p. Typeable a => JSOP p a -> K (Int, Maybe Value) a -> Either JSOPIssue a
+ Data.JSOP: paths :: All Top xs => NP (JSOP p) xs -> [p]
+ Data.JSOP: required :: p -> ValuePrism a -> JSOP p a
+ Data.JSOP: setValues :: (p -> (Bool, [Text])) -> [(p, Value)] -> Value -> Value
+ Data.JSOP: treechange :: Bool -> TPaths -> Value -> Map Int Value -> Value
+ Data.JSOP: treequery :: QPaths -> Value -> ([(Int, Value)], [Int])
+ Data.JSOP: type QPaths = Trie Text (First Int, [Int])
+ Data.JSOP: type TPaths = Trie Text (First Int, Any)
+ Data.JSOP: type ValuePrism a = APrism' Value a
+ Data.JSOP.Example: ABC :: Text -> Int -> Int -> ABC
+ Data.JSOP.Example: abc :: ABC
+ Data.JSOP.Example: cherryPickABC :: NP (JSOP Text) '[Text, Int, Int]
+ Data.JSOP.Example: data ABC
+ Data.JSOP.Example: instance GHC.Classes.Eq Data.JSOP.Example.ABC
+ Data.JSOP.Example: instance GHC.Show.Show Data.JSOP.Example.ABC
+ Data.JSOP.Example: instance Generics.SOP.Universe.Generic Data.JSOP.Example.ABC
+ Data.JSOP.Example: instance Generics.SOP.Universe.HasDatatypeInfo Data.JSOP.Example.ABC
+ Data.JSOP.Example: jsonWithABC :: Value

Files

README.md view
@@ -2,6 +2,8 @@  JSOP is good for picking out a product type value  from nested json objects  +The `jread`  memoize the keys path structure so `jread f g` should be curried to repeat on multiple values. The `Value` will be scanned only one time, despite the paths are always expressed from the root. Order is restored by a final lookup.+ ## Example  Preamble@@ -32,7 +34,6 @@  Given we have a SOP encoding of the record (tuples are good).  -The `jSOP`  memoize the keys path structure so `jSOP f g` should be curried to repeat on multiple values. The `Value` will be scanned only one time, despite the paths are always expressed from the root. Order is restored by a final lookup.  ```haskell data ABC = ABC Text Int Int deriving (Show, Eq)@@ -79,7 +80,7 @@  ```haskell  abc :: ABC-Right abc = jSOP (T.splitOn " / ") cherryPickABC jsonWithAB+Right abc = jread (T.splitOn " / ") cherryPickABC jsonWithAB ```  
jsop.cabal view
@@ -4,13 +4,13 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3f4c68738418c962984c03f7ae14cb7ab5164437477b357c723b2166f39e1402+-- hash: 441c892f8a9863538b25e6aa144e815ae93d754f131af1f0b7819536939ecacd  name:           jsop-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Cherry picking in JSON objects description:    Simple single record picking out of nested JSON objects-category:       Decoder+category:       Codec author:         Paolo Veronelli maintainer:     paolo.veronelli@gmail.com copyright:      Global Access GmbH,  Paolo Veronelli 2020@@ -23,8 +23,8 @@  library   exposed-modules:-      JSOP.Example-      JSOP.Parse+      Data.JSOP+      Data.JSOP.Example       Trie   other-modules:       Paths_jsop@@ -45,13 +45,15 @@     , tasty-discover     , tasty-hspec     , text+    , unordered-containers   default-language: Haskell2010  test-suite test   type: exitcode-stdio-1.0   main-is: Driver.hs   other-modules:-      Parse+      Read+      Write       Paths_jsop   hs-source-dirs:       test@@ -71,4 +73,5 @@     , tasty-discover     , tasty-hspec     , text+    , unordered-containers   default-language: Haskell2010
+ src/Data/JSOP.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- | Read and write a record into JSON tree+module Data.JSOP where++import Control.Lens (APrism', clonePrism, re, (%~), (.~), (^.), (^?), _1)+import Data.Aeson (Value (..), object)+import Data.Aeson.Lens+import qualified Data.HashMap.Strict as HM+import qualified Data.Map as M+import qualified Data.Map.Monoidal.Strict as Mm+import Generics.SOP+import Protolude hiding (All)+import Trie++-- | prism for a 'Value'+type ValuePrism a = APrism' Value a++-- | A record field operation specification+data JSOP p a = JSOP+  { -- | custom path encoding+    jsop_path :: p+  , -- | a default value , Nothing means value is required+    jsop_default :: Maybe a+  , -- | the prism to read and write the record field+    jsop_prism :: ValuePrism a+  }++-- | shortcut for a parser that handle missing values+required+  :: p -- ^ path+  -> ValuePrism a -- ^ prism+  -> JSOP p a+required path = JSOP path Nothing++-- | shortcut for parsers that have a default if value is missing+optional+  :: p -- ^ path+  -> a -- ^ default value+  -> ValuePrism a -- ^ prism+  -> JSOP p a+optional path = JSOP path . Just++-- | parsing problems+data JSOPIssue+  = -- | the index of the field in the record that failed, with the Value if reacheable and the requested type+    JSOPIssue (Int, Maybe Value, TypeRep)+  | -- | paths are not enough or too many+    JSOPWrongNumberOfPaths+  deriving (Eq, Show)++-- | get a record out of the json tree+jread+  :: (All Typeable xs, IsProductType a xs)+  => (path -> [Text]) -- ^ how to extract keys from a path+  -> NP (JSOP path) xs -- ^ prisms for the path-indexed values+  -> Value -- ^ json structure holding the record+  -> Either JSOPIssue a -- ^ the record , if possible+jread splitter ps value = maybe+  do Left JSOPWrongNumberOfPaths+  do+    fmap productTypeTo+      . hsequence+      . hcliftA2 (Proxy :: Proxy Typeable) parseSField ps+  do fromList $ zip [0 ..] $ getValues splitter (paths ps) value++paths :: All Top xs => NP (JSOP p) xs -> [p]+paths = hcollapse . hmap (K . jsop_path)++-- parse a single 'Value'+parseSField :: forall a p. Typeable a => JSOP p a -> K (Int, Maybe Value) a -> Either JSOPIssue a+parseSField (JSOP _ md parser) (K (n, v)) = case v of+  Nothing -> case md of+    Just x -> Right x+    Nothing -> Left $ JSOPIssue (n, v, typeOf @a $ panic "no value")+  Just w -> case w ^? clonePrism parser of+    Nothing -> Left $ JSOPIssue (n, v, typeOf @a $ panic "cannot parse")+    Just r -> Right r++--------------------------------------------------------------------------------------------+-- memoize a trie to resolve path queries+--------------------------------------------------------------------------------------------+type QPaths = Trie Text (First Int, [Int])++mkPath :: Int -> [Text] -> QPaths+mkPath n =+  foldr+    (fmap (Trie (First Nothing, [n])) . Mm.singleton)+    (Trie (First (Just n), [n]) mempty)++mkPaths :: [[Text]] -> QPaths+mkPaths = foldMap (uncurry mkPath) . zip [0 ..]++treequery :: QPaths -> Value -> ([(Int, Value)], [Int])+treequery (Trie (m, _ns) qs) v =+  appEndo (foldMap (\n -> Endo $ _1 %~ (:) (n, v)) m) $+    fold $ do+      (k, t) <- Mm.assocs qs+      pure $ case v ^? key k of+        Nothing -> ([], snd $ load t)+        Just w -> treequery t w++-- | you should close over paths argument to get an efficient Value -> [Maybe Value]+getValues+  :: (p -> [Text]) -- ^ how to extract keys from a path+  -> [p] -- ^ paths+  -> Value -- ^ json tree+  -> [Maybe Value] -- ^ found at path values+getValues splitter ts v =+  let (positive, negative) = treequery (mkPaths $ splitter <$> ts) v+   in fmap snd $+        sortOn fst $+          fmap (,Nothing) negative <> fmap (fmap Just) positive++type TPaths = Trie Text (First Int, Any)++mkTPath :: Int -> (Bool, [Text]) -> TPaths+mkTPath n (b, xs) =+  foldr+    (fmap (Trie mempty) . Mm.singleton)+    (Trie (First $ Just n, Any b) mempty)+    xs++mkTPaths :: [(Bool, [Text])] -> TPaths+mkTPaths = foldMap (uncurry mkTPath) . zip [0 ..]++treechange :: Bool -> TPaths -> Value -> Map Int Value -> Value+treechange c (Trie (m, Any b) qs) v cs = case m of+  First Nothing -> foldl' (changenode c) v $ Mm.assocs qs+  First (Just n) ->+    if c+      then if b then cs M.! n else Null+      else cs M.! n+  where+    changenode :: Bool -> Value -> (Text, TPaths) -> Value+    changenode c' w (k, rest) = case w ^? key k of+      Nothing -> _Object %~ HM.insert k (treechange True rest (object []) cs) $ w+      Just w' -> key k .~ treechange c' rest w' cs $ w++-- | you should close over paths argument to get an efficient Value -> Value+setValues+  :: (p -> (Bool, [Text])) -- ^ how to extract keys from paths, and if the path is required+  -> [(p, Value)] -- ^ what to substitute at each path+  -> Value -- ^ value to amend+  -> Value -- ^ amended value+setValues splitter ts v =+  treechange False (mkTPaths $ splitter . fst <$> ts) v $+    M.fromList $ zip [0 ..] $ snd <$> ts++-- | not very well defined write at path operation+jwrite+  :: (All Typeable xs, IsProductType a xs, All Top xs, Show path, Ord path)+  => (path -> [Text]) -- ^ how to extract keys from a path+  -> NP (JSOP path) xs -- ^ prisms for the path-indexed values+  -> Value -- ^ json 'Value' to amend+  -> a -- ^ record to write+  -> Value -- ^ amended 'Value'+jwrite splitter ps value x = setValues splitter' setters value+  where+    splitter' k = (optionals M.! k, splitter k)+    optionals = M.fromList $ (\(p, b, _) -> (p, b)) <$> ops+    ops = f ps x+    setters = (\(p, _, v) -> (p, v)) <$> ops+    f :: IsProductType a xs => NP (JSOP path) xs -> a -> [(path, Bool, Value)]+    f ps' x' = hcollapse $ hzipWith g ps' $ productTypeFrom x'+    g :: JSOP path a1 -> I a1 -> K (path, Bool, Value) a1+    g (JSOP p md parser) (I x') = K (p, isJust md, x' ^. re (clonePrism parser))
+ src/Data/JSOP/Example.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Data.JSOP.Example where++import Data.Aeson+import Data.Aeson.Lens+import Data.String.Interpolate+import qualified Data.Text as T+import Generics.SOP+import Generics.SOP.TH+import Data.JSOP+import Protolude hiding (All, optional, (:*:))+import Data.Maybe (fromJust)++data ABC = ABC Text Int Int deriving (Show, Eq)++deriveGeneric ''ABC++cherryPickABC :: NP (JSOP Text) '[Text, Int, Int]+cherryPickABC =+  required "object 1 / a string" _String+    :* required "object 2 / a number" _Integral+    :* optional "object 4 / a number" 42 _Integral+    :* Nil++jsonWithABC :: Value+jsonWithABC = fromJust . decode $ [i| +  {+    "object 1": +      { "a string": "ciao"+      , "ignore me" : 34+      }+  , "object 2": +      { "a number": 2+      , "object 3": {}+      }+  , "object 4": {+      "a plumber" :43+      } +  }+  |]++abc :: ABC+Right abc = jread (T.splitOn " / ") cherryPickABC jsonWithABC
− src/JSOP/Example.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}--module JSOP.Example where--import Data.Aeson-import Data.Aeson.Lens-import Data.String.Interpolate-import qualified Data.Text as T-import Generics.SOP-import Generics.SOP.TH-import JSOP.Parse-import Protolude hiding (All, optional, (:*:))-import Data.Maybe (fromJust)--data ABC = ABC Text Int Int deriving (Show, Eq)--deriveGeneric ''ABC--cherryPickABC :: NP (Parser Text) '[Text, Int, Int]-cherryPickABC =-  required "object 1 / a string" _String-    :* required "object 2 / a number" _Integral-    :* optional "object 4 / a number" 42 _Integral-    :* Nil--jsonWithABC :: Value-jsonWithABC = fromJust . decode $ [i| -  {-    "object 1": -      { "a string": "ciao"-      , "ignore me" : 34-      }-  , "object 2": -      { "a number": 2-      , "object 3": {}-      }-  , "object 4": {-      "a plumber" :43-      } -  }-  |]--abc :: ABC-Right abc = jSOP (T.splitOn " / ") cherryPickABC jsonWithABC
− src/JSOP/Parse.hs
@@ -1,104 +0,0 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--module JSOP.Parse where--import Control.Lens (Getting, (%~), (^?), _1)-import Data.Aeson (Value)-import Data.Aeson.Lens-import qualified Data.Map.Monoidal.Strict as Mm-import Generics.SOP-import Trie-import Protolude hiding (All)-import Data.Typeable (typeOf)---type Preview a = Getting (First a) Value a---- | A parser that can handle missing values-data Parser p a = Parser-  { parser_path :: p-  , parser_default :: Maybe a-  , parser_prism :: Preview a-  }---- | shortcut for a parser that handle missing values-required :: p -> Preview a -> Parser p a-required path = Parser path Nothing---- | shortcut for parsers that have a default if value is missing-optional :: p -> a -> Preview a -> Parser p a-optional path = Parser path . Just---- | what wrong can happen-data ParseGIssue-  = ParseGIssue (Int, Maybe Value, TypeRep)-  | ParseGWrongNumberOfValues-  deriving (Eq, Show)--jSOP-  :: (All Typeable xs, IsProductType a xs)-  => (path -> [Text])-  -> NP (Parser path) xs -- ^ parsers for the indexed subvalues-  -> Value -- ^ json structure-  -> Either ParseGIssue a-jSOP splitter ps value = maybe-  do Left ParseGWrongNumberOfValues-  do-    fmap productTypeTo-      . hsequence-      . hcliftA2 (Proxy :: Proxy Typeable) parseSField ps-  do fromList $ zip [0 ..] $ getValues splitter paths value-  where-    paths = hcollapse $ hmap (K . parser_path) ps--parseSField :: forall a p. Typeable a => Parser p a -> K (Int, Maybe Value) a -> Either ParseGIssue a-parseSField (Parser _ md parser) (K (n, v)) = case v of-  Nothing -> case md of-    Just x -> Right x-    Nothing -> Left $ ParseGIssue (n, v, typeOf @a $ panic "no value")-  Just w -> case w ^? parser of-    Nothing -> Left $ ParseGIssue (n, v, typeOf @a $ panic "cannot parse")-    Just r -> Right r------------------------------------------------------------------------------------------------- memoize a trie to resolve path queries----------------------------------------------------------------------------------------------type Paths = Trie Text (First Int, [Int])--mkPath :: Int -> [Text] -> Paths-mkPath n =-  foldr-    (fmap (Trie (First Nothing, [n])) . Mm.singleton)-    (Trie (First (Just n), [n]) mempty)--mkPaths :: [[Text]] -> Paths-mkPaths = foldMap (uncurry mkPath) . zip [0 ..]--treequery :: Paths -> Value -> ([(Int, Value)], [Int])-treequery (Trie (m, _ns) qs) v =-  appEndo (foldMap (\n -> Endo $ _1 %~ (:) (n, v)) m) $-    fold $ do-      (k, t) <- Mm.assocs qs-      pure $ case v ^? key k of-        Nothing -> ([], snd $ load t)-        Just w -> treequery t w---- | close over paths argument to get an efficient Value -> [Maybe Value]-getValues :: (p -> [Text]) -> [p] -> Value -> [Maybe Value]-getValues splitter ts v =-  let (positive, negative) = treequery (mkPaths $ splitter <$> ts) v-   in fmap snd $-        sortOn fst $-          fmap (,Nothing) negative <> fmap (fmap Just) positive
− test/Parse.hs
@@ -1,107 +0,0 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications, QuasiQuotes #-}--module Parse where--import Data.Aeson-import Data.Aeson.Lens-import qualified Data.Text as T-import Generics.SOP-import JSOP.Parse-import Protolude hiding (All, optional, (:*:))-import Test.Tasty.Hspec (Spec, describe, it, shouldBe)-import Data.Maybe (fromJust)-import Data.String.Interpolate --jSOP'-  :: (All Typeable xs, IsProductType a xs)-  => NP (Parser Text) xs-  -> Value-  -> Either ParseGIssue a-jSOP' = jSOP $ T.splitOn " / " --decodeU :: Text -> Value -decodeU = fromJust . decode . toS--spec_generic :: Spec-spec_generic = do-  describe "generic parsers" do-    it "can parse an Int in an object" $ shouldBe-      do-        jSOP'-          do required "a number" _Integral :* Nil-          do object ["a number" .= Number 2]-      do Right (Identity (2 :: Int))-    it "can parse an Int in an nested object" $ shouldBe-      do-        jSOP'-          do required "object / a number" _Integral :* Nil-          do-            object-              [ "object" .= object ["a number" .= Number 2]-              ]-      do Right (Identity (2 :: Int))-    it "can parse String and Integer" $ shouldBe-      do-        jSOP'-          do-            required "a string" _String-              :* required "a number" _Integral-              :* Nil-          do-            object-              [ "a number" .= Number 2-              , "a string" .= ("ciao" :: Text)-              ]-      do Right ("ciao", 2 :: Int)-    it "can parse String and Int down different paths" $ shouldBe-      do-        jSOP -          do T.splitOn " / " -          do-            required "object 1 / a string" _String-              :* required "object 2 / a number" _Integral-              :* Nil-          do decodeU [i| -              {-                "object 1": -                  { "a string": "ciao"-                  , "ignore me" : 34-                  }-              , "object 2": -                  { "a number": 2-                  , "object 3": {}-                  }-              }-              |]-      do Right ("ciao", 2 :: Int)-    it "can parse String and Int and Optional Int down different paths" $ shouldBe-      do-        jSOP -          do T.splitOn " / " -          do-            required "object 1 / a string" _String-              :* required "object 2 / a number" _Integral-              :* optional "object 4 / a number" 42 _Integral-              :* Nil-          do decodeU [i| -              {-                "object 1": -                  { "a string": "ciao"-                  , "ignore me" : 34-                  }-              , "object 2": -                  { "a number": 2-                  , "object 3": {}-                  }-              , "object 4": {-                  "a plumber" :43-                  } -              }-              |]-      do Right ("ciao", 2 :: Int, 42 :: Int )-
+ test/Read.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications, QuasiQuotes #-}++module Read where++import Data.Aeson+import Data.Aeson.Lens+import qualified Data.Text as T+import Generics.SOP+import Data.JSOP+import Protolude hiding (All, optional, (:*:))+import Test.Tasty.Hspec (Spec, describe, it, shouldBe)+import Data.Maybe (fromJust)+import Data.String.Interpolate +++decodeU :: Text -> Value +decodeU = fromJust . decode . toUtf8Lazy++spec_generic :: Spec+spec_generic = do+  describe "jsop" do+    it "can read an Int in an object" $ shouldBe+      do+        jread +          do T.splitOn " / "+          do required "a number" _Integral :* Nil+          do object ["a number" .= Number 2]+      do Right (Identity (2 :: Int))+    it "can read an Int in an nested object" $ shouldBe+      do+        jread +          do T.splitOn " / "+          do required "object / a number" _Integral :* Nil+          do+            object+              [ "object" .= object ["a number" .= Number 2]+              ]+      do Right (Identity (2 :: Int))+    it "can read String and Integer" $ shouldBe+      do+        jread +          do T.splitOn " / "+          do+            required "a string" _String+              :* required "a number" _Integral+              :* Nil+          do+            object+              [ "a number" .= Number 2+              , "a string" .= ("ciao" :: Text)+              ]+      do Right ("ciao", 2 :: Int)+    it "can read String and Int down different paths" $ shouldBe+      do+        jread +          do T.splitOn " / " +          do+            required "object 1 / a string" _String+              :* required "object 2 / a number" _Integral+              :* Nil+          do decodeU [i| +              {+                "object 1": +                  { "a string": "ciao"+                  , "ignore me" : 34+                  }+              , "object 2": +                  { "a number": 2+                  , "object 3": {}+                  }+              }+              |]+      do Right ("ciao", 2 :: Int)+    it "can read String and Int and Optional Int down different paths" $ shouldBe+      do+        jread +          do T.splitOn " / " +          do+            required "object 1 / a string" _String+              :* required "object 2 / a number" _Integral+              :* optional "object 4 / a number" 42 _Integral+              :* Nil+          do decodeU [i| +              {+                "object 1": +                  { "a string": "ciao"+                  , "ignore me" : 34+                  }+              , "object 2": +                  { "a number": 2+                  , "object 3": {}+                  }+              , "object 4": {+                  "a plumber" :43+                  } +              }+              |]+      do Right ("ciao", 2 :: Int, 42 :: Int )
+ test/Write.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications, QuasiQuotes #-}++module Write where++import Data.Aeson+import Data.Aeson.Lens+import qualified Data.Text as T+import Generics.SOP+import Data.JSOP+import Protolude hiding (All, optional, (:*:))+import Test.Tasty.Hspec (Spec, it, shouldBe, describe)+import Data.String.Interpolate +import Protolude.Partial (fromJust)++decodeU :: Text -> Value +decodeU = fromJust . decode . toUtf8Lazy++spec_write :: Spec+spec_write = do+  describe "jsop" do+    it "can write an Int in an object" $ shouldBe+      do+        jwrite +          do T.splitOn " / " +          do required "a number" _Integral :* Nil+          do object ["a number" .= Number 0]+          do Identity (2 :: Int)+      do object ["a number" .= Number 2]+    it "can write an Int in an nested object" $ shouldBe+      do+        jwrite +          do T.splitOn " / " +          do required "object / a number" _Integral :* Nil+          do+            object+              [ "object" .= object ["a number" .= Number 0]+              ]+          do Identity (2 :: Int)+      do+            object+              [ "object" .= object ["a number" .= Number 2]+              ]+    it "can write String and Integer" $ shouldBe+      do+        jwrite +          do T.splitOn " / " +          do+            required "a string" _String+              :* required "a number" _Integral+              :* Nil+          do+            object+              [ "a number" .= Number 0+              , "a string" .= ("mamma" :: Text)+              ]+          do ("ciao", 2 :: Int)+      do+            object+              [ "a number" .= Number 2+              , "a string" .= ("ciao" :: Text)+              ]+    it "can write String and Int and Optional Int down different paths" $ shouldBe+      do+        jwrite +          do T.splitOn " / " +          do+            required "object 1 / a string" _String+              :* required "object 2 / a number" _Integral+              :* optional "object 4 / a number" 42 _Integral+              :* Nil+          do decodeU [i| +              {+                "object 1": +                  { "a string": "mamma"+                  , "ignore me" : 34+                  }+              , "object 2": +                  { "a number": 0+                  , "object 3": {}+                  }+              , "object 4": {+                  "a plumber" :43+                  } +              }+              |]+          do ("ciao", 2 :: Int, 42 :: Int )+      do decodeU [i| +              {+                "object 1": +                  { "a string": "ciao"+                  , "ignore me" : 34+                  }+              , "object 2": +                  { "a number": 2+                  , "object 3": {}+                  }+              , "object 4": {+                  "a plumber" :43+                  , "a number" :42+                  } +              }+              |]+    it "can write String and Int and Optional Int down different paths in emptyness" $ shouldBe+      do+        jwrite +          do T.splitOn " / " +          do+            required "object 1 / a string" _String+              :* required "object 2 / a number" _Integral+              :* optional "object 4 / a number" 42 _Integral+              :* Nil+          do decodeU [i| +              {+              }+              |]+          do ("ciao", 2 :: Int, 42 :: Int )+      do decodeU [i| +              {+                "object 1": +                  { "a string": null+                  }+              , "object 2": +                  { "a number": null+                  }+              , "object 4": {+                   "a number" :42+                  } +              }+              |]++