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 +3/−2
- jsop.cabal +9/−6
- src/Data/JSOP.hs +179/−0
- src/Data/JSOP/Example.hs +53/−0
- src/JSOP/Example.hs +0/−53
- src/JSOP/Parse.hs +0/−104
- test/Parse.hs +0/−107
- test/Read.hs +103/−0
- test/Write.hs +136/−0
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+ } + }+ |]++