From 74e46e3ed903e469f23028edcb029c9c6ba989de Mon Sep 17 00:00:00 2001 From: Eric Pashman Date: Wed, 20 Sep 2023 16:41:27 -0600 Subject: [PATCH] Update for Stack LTS 21.9 --- json-alt/json-alt.cabal | 9 +- json-alt/package.yaml | 4 +- json-autotype/app/GenerateJSONParser.hs | 1 + json-autotype/json-autotype.cabal | 192 +++++++++--------- json-autotype/package.yaml | 68 +++---- .../src/Data/Aeson/AutoType/Extract.hs | 19 +- .../src/Data/Aeson/AutoType/Pretty.hs | 14 ++ json-autotype/src/Data/Aeson/AutoType/Test.hs | 42 ++-- json-autotype/src/Data/Aeson/AutoType/Type.hs | 10 +- json-autotype/src/Data/Aeson/AutoType/Util.hs | 5 - json-autotype/test/TestExamples.hs | 15 +- json-autotype/test/gen/GenerateTestJSON.hs | 19 -- stack.yaml | 2 +- stack.yaml.lock | 10 +- 14 files changed, 194 insertions(+), 216 deletions(-) diff --git a/json-alt/json-alt.cabal b/json-alt/json-alt.cabal index 86a62a0..90ef72c 100644 --- a/json-alt/json-alt.cabal +++ b/json-alt/json-alt.cabal @@ -1,12 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack --- name: json-alt -version: 1.0.1 +version: 1.0.0 synopsis: Union 'alternative' or Either that has untagged JSON encoding. description: Parsing JSON with Aeson often requires decoding fields that have more than one Haskell type. @@ -64,6 +63,6 @@ library DeriveGeneric RecordWildCards build-depends: - aeson >=1.2.1 && <1.6 - , base >=4.3 && <5 + aeson + , base >=4.0.0 && <=5.0 default-language: Haskell2010 diff --git a/json-alt/package.yaml b/json-alt/package.yaml index 8f6d36c..1cacf66 100644 --- a/json-alt/package.yaml +++ b/json-alt/package.yaml @@ -60,8 +60,8 @@ other-extensions: - DeriveGeneric - RecordWildCards dependencies: -- base >=4.3 && <5 -- aeson >=1.2.1 && <1.6 +- base >= 4.0.0 && <= 5.0 +- aeson library: exposed-modules: - Data.Aeson.AutoType.Alternative diff --git a/json-autotype/app/GenerateJSONParser.hs b/json-autotype/app/GenerateJSONParser.hs index 4fe6dd7..bf1ede3 100644 --- a/json-autotype/app/GenerateJSONParser.hs +++ b/json-autotype/app/GenerateJSONParser.hs @@ -32,6 +32,7 @@ import Data.Aeson.AutoType.Format import Data.Aeson.AutoType.Split import Data.Aeson.AutoType.Type import Data.Aeson.AutoType.Util +import Data.Aeson.AutoType.Pretty import qualified Data.Yaml as Yaml import Options.Applicative diff --git a/json-autotype/json-autotype.cabal b/json-autotype/json-autotype.cabal index 8ed6199..ed8f21d 100644 --- a/json-autotype/json-autotype.cabal +++ b/json-autotype/json-autotype.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: json-autotype -version: 3.1.3 +version: 3.1.2 synopsis: Automatic type declaration for JSON input data description: Generates datatype declarations with Aeson''s ''Data.Aeson.FromJSON'' . @@ -87,12 +87,12 @@ library Data.Aeson.AutoType.CodeGen.Generic Data.Aeson.AutoType.CodeGen.Elm Data.Aeson.AutoType.CodeGen.ElmFormat - Data.Aeson.AutoType.Pretty Data.Aeson.AutoType.Split Data.Aeson.AutoType.Type Data.Aeson.AutoType.Test Data.Aeson.AutoType.Util Data.Aeson.AutoType.Nested + Data.Aeson.AutoType.Pretty other-modules: Data.Aeson.AutoType.CodeGen.Common Data.Aeson.AutoType.Plugin.Subtype @@ -109,27 +109,27 @@ library DeriveGeneric RecordWildCards build-depends: - GenericPretty ==1.2.* - , QuickCheck >=2.4 && <3.0 - , aeson >=1.2.1 && <1.6 - , base >=4.9 && <5 - , containers >=0.3 && <0.7 - , data-default ==0.7.* - , filepath >=1.3 && <1.5 - , hashable >=1.2 && <1.4 + GenericPretty + , QuickCheck + , aeson + , base >=4.0.0 && <5.0 + , containers + , data-default + , filepath + , hashable , json-alt - , lens >=4.1 && <4.20 - , mtl >=2.1 && <2.3 - , pretty >=1.1 && <1.3 - , process >=1.1 && <1.7 + , lens + , mtl + , pretty + , process , run-haskell-module - , scientific >=0.3 && <0.5 - , smallcheck >=1.0 && <1.2 + , scientific + , smallcheck , template-haskell - , text >=1.1 && <1.4 - , uniplate ==1.6.* - , unordered-containers ==0.2.* - , vector >=0.9 && <0.13 + , text + , uniplate + , unordered-containers + , vector default-language: Haskell2010 executable json-autotype @@ -150,27 +150,27 @@ executable json-autotype DeriveGeneric RecordWildCards build-depends: - GenericPretty ==1.2.* - , aeson >=1.2.1 && <1.6 - , base >=4.9 && <5 - , bytestring >=0.9 && <0.11 - , containers >=0.3 && <0.7 - , filepath >=1.3 && <1.5 - , hashable >=1.2 && <1.4 + GenericPretty + , aeson + , base >=4.0.0 && <5.0 + , bytestring + , containers + , filepath + , hashable , json-alt , json-autotype - , lens >=4.1 && <4.20 - , mtl >=2.1 && <2.3 - , optparse-applicative >=0.12 && <1.0 - , pretty >=1.1 && <1.3 - , process >=1.1 && <1.7 - , scientific >=0.3 && <0.5 + , lens + , mtl + , optparse-applicative + , pretty + , process + , scientific , template-haskell - , text >=1.1 && <1.4 - , uniplate ==1.6.* - , unordered-containers ==0.2.* - , vector >=0.9 && <0.13 - , yaml >=0.8 && <0.12 + , text + , uniplate + , unordered-containers + , vector + , yaml default-language: Haskell2010 test-suite json-autotype-examples @@ -192,28 +192,28 @@ test-suite json-autotype-examples DeriveGeneric RecordWildCards build-depends: - GenericPretty ==1.2.* - , QuickCheck >=2.4 && <3.0 - , aeson >=1.2.1 && <1.6 - , base >=4.9 && <5 - , containers >=0.3 && <0.7 - , directory >=1.1 && <1.4 - , filepath >=1.3 && <1.5 - , hashable >=1.2 && <1.4 + GenericPretty + , QuickCheck + , aeson + , base >=4.0.0 && <5.0 + , containers + , directory + , filepath + , hashable , json-alt , json-autotype - , lens >=4.1 && <4.20 - , mtl >=2.1 && <2.3 - , optparse-applicative >=0.11 && <1.0 - , pretty >=1.1 && <1.3 - , process >=1.1 && <1.7 - , scientific >=0.3 && <0.5 - , smallcheck >=1.0 && <1.2 + , lens + , mtl + , optparse-applicative + , pretty + , process + , scientific + , smallcheck , template-haskell - , text >=1.1 && <1.4 - , uniplate ==1.6.* - , unordered-containers ==0.2.* - , vector >=0.9 && <0.13 + , text + , uniplate + , unordered-containers + , vector default-language: Haskell2010 test-suite json-autotype-gen-test @@ -235,29 +235,29 @@ test-suite json-autotype-gen-test DeriveGeneric RecordWildCards build-depends: - GenericPretty ==1.2.* - , QuickCheck >=2.4 && <3.0 - , aeson >=1.2.1 && <1.6 - , base >=4.9 && <5 - , bytestring >=0.9 && <0.11 - , containers >=0.3 && <0.7 - , directory >=1.1 && <1.4 - , filepath >=1.3 && <1.5 - , hashable >=1.2 && <1.4 + GenericPretty + , QuickCheck + , aeson + , base >=4.0.0 && <5.0 + , bytestring + , containers + , directory + , filepath + , hashable , json-alt , json-autotype - , lens >=4.1 && <4.20 - , mtl >=2.1 && <2.3 - , optparse-applicative >=0.12 && <1.0 - , pretty >=1.1 && <1.3 - , process >=1.1 && <1.7 - , scientific >=0.3 && <0.5 - , smallcheck >=1.0 && <1.2 + , lens + , mtl + , optparse-applicative + , pretty + , process + , scientific + , smallcheck , template-haskell - , text >=1.1 && <1.4 - , uniplate ==1.6.* - , unordered-containers ==0.2.* - , vector >=0.9 && <0.13 + , text + , uniplate + , unordered-containers + , vector default-language: Haskell2010 test-suite json-autotype-qc-test @@ -279,25 +279,25 @@ test-suite json-autotype-qc-test DeriveGeneric RecordWildCards build-depends: - GenericPretty ==1.2.* - , QuickCheck >=2.4 && <3.0 - , aeson >=1.2.1 && <1.6 - , base >=4.9 && <5 - , containers >=0.3 && <0.7 - , filepath >=1.3 && <1.5 - , hashable >=1.2 && <1.4 + GenericPretty + , QuickCheck + , aeson + , base >=4.0.0 && <5.0 + , containers + , filepath + , hashable , json-alt , json-autotype - , lens >=4.1 && <4.20 - , mtl >=2.1 && <2.3 - , optparse-applicative >=0.12 && <1.0 - , pretty >=1.1 && <1.3 - , process >=1.1 && <1.7 - , scientific >=0.3 && <0.5 - , smallcheck >=1.0 && <1.2 + , lens + , mtl + , optparse-applicative + , pretty + , process + , scientific + , smallcheck , template-haskell - , text >=1.1 && <1.4 - , uniplate ==1.6.* - , unordered-containers ==0.2.* - , vector >=0.9 && <0.13 + , text + , uniplate + , unordered-containers + , vector default-language: Haskell2010 diff --git a/json-autotype/package.yaml b/json-autotype/package.yaml index 5c59f70..dd3bb0f 100644 --- a/json-autotype/package.yaml +++ b/json-autotype/package.yaml @@ -73,21 +73,21 @@ other-extensions: - DeriveGeneric - RecordWildCards dependencies: -- base >=4.9 && <5 -- GenericPretty >=1.2 && <1.3 -- aeson >=1.2.1 && <1.6 -- containers >=0.3 && <0.7 -- filepath >=1.3 && <1.5 -- hashable >=1.2 && <1.4 -- lens >=4.1 && <4.20 -- mtl >=2.1 && <2.3 -- pretty >=1.1 && <1.3 -- process >=1.1 && <1.7 -- scientific >=0.3 && <0.5 -- text >=1.1 && <1.4 -- uniplate >=1.6 && <1.7 -- unordered-containers >=0.2 && <0.3 -- vector >=0.9 && <0.13 +- base >= 4.0.0 && < 5.0 +- GenericPretty +- aeson +- containers +- filepath +- hashable +- lens +- mtl +- pretty +- process +- scientific +- text +- uniplate +- unordered-containers +- vector - json-alt - template-haskell library: @@ -101,16 +101,16 @@ library: - Data.Aeson.AutoType.CodeGen.Generic - Data.Aeson.AutoType.CodeGen.Elm - Data.Aeson.AutoType.CodeGen.ElmFormat - - Data.Aeson.AutoType.Pretty - Data.Aeson.AutoType.Split - Data.Aeson.AutoType.Type - Data.Aeson.AutoType.Test - Data.Aeson.AutoType.Util - Data.Aeson.AutoType.Nested + - Data.Aeson.AutoType.Pretty dependencies: - - data-default >=0.7 && <0.8 - - smallcheck >=1.0 && <1.2 - - QuickCheck >=2.4 && <3.0 + - data-default + - smallcheck + - QuickCheck - run-haskell-module executables: json-autotype: @@ -119,9 +119,9 @@ executables: - app - common dependencies: - - bytestring >=0.9 && <0.11 - - optparse-applicative >=0.12 && <1.0 - - yaml >=0.8 && <0.12 + - bytestring + - optparse-applicative + - yaml - json-autotype tests: json-autotype-examples: @@ -130,10 +130,10 @@ tests: - test - common dependencies: - - directory >=1.1 && <1.4 - - optparse-applicative >=0.11 && <1.0 - - smallcheck >=1.0 && <1.2 - - QuickCheck >=2.4 && <3.0 + - directory + - optparse-applicative + - smallcheck + - QuickCheck - json-autotype json-autotype-qc-test: main: TestQC.hs @@ -141,9 +141,9 @@ tests: - test/qc - common dependencies: - - smallcheck >=1.0 && <1.2 - - optparse-applicative >=0.12 && <1.0 - - QuickCheck >=2.4 && <3.0 + - smallcheck + - optparse-applicative + - QuickCheck - json-autotype json-autotype-gen-test: main: GenerateTestJSON.hs @@ -151,10 +151,10 @@ tests: - test/gen - common dependencies: - - bytestring >=0.9 && <0.11 - - directory >=1.1 && <1.4 - - optparse-applicative >=0.12 && <1.0 - - smallcheck >=1.0 && <1.2 - - QuickCheck >=2.4 && <3.0 + - bytestring + - directory + - optparse-applicative + - smallcheck + - QuickCheck - json-autotype stability: stable diff --git a/json-autotype/src/Data/Aeson/AutoType/Extract.hs b/json-autotype/src/Data/Aeson/AutoType/Extract.hs index 2e636e7..8070d06 100644 --- a/json-autotype/src/Data/Aeson/AutoType/Extract.hs +++ b/json-autotype/src/Data/Aeson/AutoType/Extract.hs @@ -7,10 +7,12 @@ module Data.Aeson.AutoType.Extract(valueSize, valueTypeSize, import Control.Arrow ((&&&)) import Control.Exception (assert) +import Data.Aeson.Key (toText) +import Data.Aeson.KeyMap (toHashMap) import Data.Aeson.AutoType.Type import qualified Data.Graph as Graph import qualified Data.HashMap.Strict as Map -import Data.HashMap.Strict (HashMap) +import Data.HashMap.Strict (HashMap, mapKeys) import qualified Data.Set as Set import qualified Data.Vector as V import Data.Aeson @@ -21,6 +23,9 @@ import Data.Scientific (isInteger) --import Debug.Trace +-- Convert from Aeson's @KeyMap v@ type to Autotype's @HashMap Text v@ type. +toHashMapTxt = mapKeys toText . toHashMap + -- | Compute total number of nodes (and leaves) within the value tree. -- Each simple JavaScript type (including String) is counted as of size 1, -- whereas both Array or object types are counted as 1+sum of the sizes @@ -31,7 +36,7 @@ valueSize (Bool _) = 1 valueSize (Number _) = 1 valueSize (String _) = 1 valueSize (Array a) = V.foldl' (+) 1 $ V.map valueSize a -valueSize (Object o) = (1+) . sum . map valueSize . Map.elems $ o +valueSize (Object o) = (1+) . sum . map valueSize . Map.elems $ toHashMapTxt o -- | Compute total size of the type of the @Value@. -- For: @@ -45,7 +50,7 @@ valueTypeSize (Bool _) = 1 valueTypeSize (Number _) = 1 valueTypeSize (String _) = 1 valueTypeSize (Array a) = (1+) . V.foldl' max 0 $ V.map valueTypeSize a -valueTypeSize (Object o) = (1+) . sum . map valueTypeSize . Map.elems $ o +valueTypeSize (Object o) = (1+) . sum . map valueTypeSize . Map.elems $ toHashMapTxt o -- | Compute total depth of the value. -- For: @@ -57,13 +62,13 @@ valueDepth (Bool _) = 1 valueDepth (Number _) = 1 valueDepth (String _) = 1 valueDepth (Array a) = (1+) . V.foldl' max 0 $ V.map valueDepth a -valueDepth (Object o) = (1+) . maximum . (0:) . map valueDepth . Map.elems $ o +valueDepth (Object o) = (1+) . maximum . (0:) . map valueDepth . Map.elems $ toHashMapTxt o -- | Check if a number is integral, or floating point -- | Extract @Type@ from the JSON @Value@. -- Unifying types of array elements, if necessary. extractType :: Value -> Type -extractType (Object o) = TObj $ Dict $ Map.map extractType o +extractType (Object o) = TObj $ Dict $ Map.map extractType $ toHashMapTxt o extractType Null = TNull extractType (Bool _) = TBool extractType (Number n) | isInteger n = TInt @@ -86,11 +91,11 @@ typeCheck (Number _) TDouble = True typeCheck (Array elts) (TArray eltType) = (`typeCheck` eltType) `all` V.toList elts typeCheck (Object d) (TObj e ) = typeCheckKey `all` keysOfBoth where - typeCheckKey k = getValue k d `typeCheck` get k e + typeCheckKey k = getValue k (toHashMapTxt d) `typeCheck` get k e getValue :: Text -> HashMap Text Value -> Value getValue = Map.lookupDefault Null keysOfBoth :: [Text] - keysOfBoth = Set.toList $ Set.fromList (Map.keys d) `Set.union` keys e + keysOfBoth = Set.toList $ Set.fromList (Map.keys $ toHashMapTxt d) `Set.union` keys e typeCheck _ (TLabel _ ) = error "Cannot typecheck labels without environment!" typeCheck {-a-} _ _ {-b-} = {-trace msg $-} False where diff --git a/json-autotype/src/Data/Aeson/AutoType/Pretty.hs b/json-autotype/src/Data/Aeson/AutoType/Pretty.hs index 035e99e..91e06f7 100644 --- a/json-autotype/src/Data/Aeson/AutoType/Pretty.hs +++ b/json-autotype/src/Data/Aeson/AutoType/Pretty.hs @@ -13,6 +13,8 @@ module Data.Aeson.AutoType.Pretty() where import qualified Data.HashMap.Strict as Hash import Data.HashMap.Strict(HashMap) import Data.Aeson +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.AutoType.Type (Dict(..), Type) import qualified Data.Text as Text import Data.Text (Text) import Data.Set as Set(Set, toList) @@ -43,6 +45,18 @@ instance (Out a, Out b) => Out (HashMap a b) where doc (Hash.toList -> dict) = foldl ($$) "{" (map formatPair dict) $$ nest 1 "}" docPrec _ = doc +instance (Out v) => Out (KM.KeyMap v) where + doc (KM.toList -> dict) = foldl ($$) "{" (map formatKeyValPair dict) $$ nest 1 "}" + where + formatKeyValPair (k, v) = nest 1 (doc (show k) <+> ": " <+> doc v <+> ",") + docPrec _ = doc + +instance Out Dict where + doc = doc . unDict + +instance Out Type where + doc = doc . show + instance Out Text where doc = text . Text.unpack -- TODO: check if there may be direct way? docPrec _ = doc diff --git a/json-autotype/src/Data/Aeson/AutoType/Test.hs b/json-autotype/src/Data/Aeson/AutoType/Test.hs index bd79926..a294b1d 100644 --- a/json-autotype/src/Data/Aeson/AutoType/Test.hs +++ b/json-autotype/src/Data/Aeson/AutoType/Test.hs @@ -2,13 +2,13 @@ {-# LANGUAGE MultiParamTypeClasses #-} -- | Arbitrary instances for the JSON @Value@. module Data.Aeson.AutoType.Test ( - arbitraryTopValue + arbitraryTopValue ) where -import Data.Aeson.AutoType.Pretty () -- Generic instance for Value - import Control.Applicative ((<$>), (<*>)) import Data.Aeson +import Data.Aeson.Key (fromText) +import qualified Data.Aeson.KeyMap as KM import Data.Function (on) import Data.Hashable (Hashable) import Data.Generics.Uniplate.Data @@ -45,48 +45,38 @@ makeMap = Map.fromList instance Arbitrary Scientific where arbitrary = scientific <$> arbitrary <*> arbitrary --- TODO: top value has to be complex: Object or Array --- TODO: how to accumulate cost when generating the series? -instance Arbitrary Value where - arbitrary = sized arb - where - arb n | n < 0 = error "Negative size!" - arb 0 = return Null - arb 1 = oneof simpleGens - arb i = oneof $ complexGens (i - 1) ++ simpleGens - simpleGens = [Number <$> arbitrary - ,Bool <$> arbitrary - ,String <$> arbitrary] - shrink = concatMap simpleShrink - . universe - -- | Transformation to shrink top level of @Value@, doesn't consider nested sub-@Value@s. simpleShrink :: Value -> [Value] -simpleShrink (Array a) = map (Array . V.fromList) $ shrink $ V.toList a -simpleShrink (Object o) = map (Object . Map.fromList) $ shrink $ Map.toList o +simpleShrink (Array a) = map (Array . V.fromList) $ shrink $ V.toList a +simpleShrink (Object o) = map (Object . KM.fromList) $ shrink $ KM.toList o simpleShrink _ = [] -- Nothing for simple objects -- | Generator for compound @Value@s complexGens :: Int -> [Gen Value] -complexGens i = [Object . Map.fromList <$> resize i arbitrary, - Array <$> resize i arbitrary] +complexGens i = [Object . KM.fromList <$> resize i arbitrary, + Array <$> resize i arbitrary] -- | Arbitrary JSON (must start with Object or Array.) arbitraryTopValue :: Gen Value arbitraryTopValue = sized $ oneof . complexGens -- * SmallCheck Serial instances -instance Monad m => Serial m Text where +instance (Monad m) => Serial m Text where series = newtypeCons Text.pack -instance Monad m => Serial m Scientific where +instance (Monad m) => Serial m Scientific where series = cons2 scientific instance Serial m a => Serial m (V.Vector a) where series = newtypeCons V.fromList -instance Serial m v => Serial m (Map.HashMap Text v) where - series = newtypeCons makeMap +instance (Monad m) => Serial m Key where + series = fmap fromText series + +instance Serial m v => Serial m (KM.KeyMap v) where + series = newtypeCons $ KM.fromList + . nubBy ((==) `on` fst) + . sortBy (compare `on` fst) -- This one is generated with Generics and instances above instance Monad m => Serial m Value diff --git a/json-autotype/src/Data/Aeson/AutoType/Type.hs b/json-autotype/src/Data/Aeson/AutoType/Type.hs index 05e4367..34ce64c 100644 --- a/json-autotype/src/Data/Aeson/AutoType/Type.hs +++ b/json-autotype/src/Data/Aeson/AutoType/Type.hs @@ -26,9 +26,7 @@ import Data.HashMap.Strict(HashMap) import Data.List (sort) import Data.Ord (comparing) import Data.Generics.Uniplate -import Text.PrettyPrint.GenericPretty - -import Data.Aeson.AutoType.Pretty () +import GHC.Generics (Generic) -- * Dictionary types for overloading of usual class instances. -- | Type alias for HashMap @@ -38,10 +36,6 @@ type Map = HashMap newtype Dict = Dict { unDict :: Map Text Type } deriving (Eq, Data, Typeable, Generic) -instance Out Dict where - doc = doc . unDict - docPrec p = docPrec p . unDict - instance Show Dict where show = show . sort . Hash.toList . unDict @@ -65,8 +59,6 @@ data Type = TNull | TBool | TString | TArray Type deriving (Show,Eq, Ord, Data, Typeable, Generic) -instance Out Type - -- These are missing Uniplate instances... {- instance Biplate (Set a) a where diff --git a/json-autotype/src/Data/Aeson/AutoType/Util.hs b/json-autotype/src/Data/Aeson/AutoType/Util.hs index db99e3e..59bc948 100644 --- a/json-autotype/src/Data/Aeson/AutoType/Util.hs +++ b/json-autotype/src/Data/Aeson/AutoType/Util.hs @@ -27,8 +27,3 @@ withFileOrDefaultHandle "-" otherMode _ = error $ "Incompatible ++ show otherMode ++ ") for `-` in withFileOrDefaultHandle." withFileOrDefaultHandle filename ioMode action = withFile filename ioMode action - --- Missing instances -instance Hashable a => Hashable (Set.Set a) where - hashWithSalt = Set.foldr (flip hashWithSalt) - diff --git a/json-autotype/test/TestExamples.hs b/json-autotype/test/TestExamples.hs index 5da565e..7fc4716 100644 --- a/json-autotype/test/TestExamples.hs +++ b/json-autotype/test/TestExamples.hs @@ -13,9 +13,10 @@ import System.Environment as Env import System.Process (rawSystem) import Data.Aeson.AutoType.CodeGen(runModule, Lang(Haskell)) import Data.Aeson ( Result, Object, FromJSON, Value(Null,Number), (.:?) ) +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.Key (fromString, fromText) import Data.Aeson.Types ( Parser, parse ) import Data.Text ( Text, pack ) -import Data.HashMap.Lazy ( singleton, empty ) -- | @@ -82,16 +83,16 @@ runAutotype source arguments = do verifyAesonOperators :: IO () verifyAesonOperators = do - parseTest (singleton (pack "foo") (Number 1)) - parseTest (singleton (pack "foo") Null ) - parseTest (singleton (pack "bar") Null ) - parseTest empty + parseTest (KM.singleton (fromString "foo") (Number 1)) + parseTest (KM.singleton (fromString "foo") Null ) + parseTest (KM.singleton (fromString "bar") Null ) + parseTest KM.empty (.:??) :: FromJSON a => Object -> Text -> Parser (Maybe a) -o .:?? val = fmap join (o .:? val) +o .:?? val = fmap join (o .:? fromText val) parseTest :: Object -> IO () parseTest o = unless (r1 == r2) (fail (show r1 ++ " /= " ++ show r2)) where r1, r2 :: Result (Maybe Int) - r1 = parse (.:? (pack "foo")) o + r1 = parse (.:? (fromString "foo")) o r2 = parse (.:?? (pack "foo")) o diff --git a/json-autotype/test/gen/GenerateTestJSON.hs b/json-autotype/test/gen/GenerateTestJSON.hs index 31068f8..4be8130 100644 --- a/json-autotype/test/gen/GenerateTestJSON.hs +++ b/json-autotype/test/gen/GenerateTestJSON.hs @@ -109,25 +109,6 @@ removeDuplicates list = filterM checkDup list `evalState` Set.empty State.put $ x `Set.insert` seen return True --- TODO: check for generic Ord? -instance Ord Value where - Null `compare` Null = EQ - Null `compare` _ = LT - _ `compare` Null = GT - (Bool a) `compare` (Bool b) = a `compare` b - (Bool a) `compare` _ = LT - _ `compare` (Bool b) = GT - (Number a) `compare` (Number b) = a `compare` b - (Number _) `compare` _ = LT - _ `compare` (Number _) = GT - (String a) `compare` (String b) = a `compare` b - (String a) `compare` _ = LT - _ `compare` (String b) = GT - (Array a) `compare` (Array b) = a `compare` b - (Array a) `compare` _ = LT - _ `compare` (Array b) = GT - (Object a) `compare` (Object b) = Map.toList a `compare` Map.toList b - -- | Take a set of JSON input filenames, Haskell output filename, and generate module parsing these JSON files. generateTestJSONs :: Options -> IO () generateTestJSONs Options {tyOpts=TyOptions {..}, diff --git a/stack.yaml b/stack.yaml index 95ddc72..2ba0815 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-12.26 +resolver: lts-21.9 packages: - json-autotype diff --git a/stack.yaml.lock b/stack.yaml.lock index 4733614..ed287d6 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -7,13 +7,13 @@ packages: - completed: hackage: GenericPretty-1.2.2@sha256:65fd4aeedc326c356a866169e3511ef14fd6b3284ff9c29273f8a3b90dc9e5eb,3698 pantry-tree: - size: 719 sha256: 1e9f020c022023084c2a0e1650d21ea7cd87fe9a97a9f21c691b664d65142250 + size: 719 original: hackage: GenericPretty-1.2.2 snapshots: - completed: - size: 509471 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/26.yaml - sha256: 95f014df58d0679b1c4a2b7bf2b652b61da8d30de5f571abb0d59015ef678646 - original: lts-12.26 + sha256: 2fc12a405ab6f7eac73eb11a0ca5ccca0e956bd2848db780c140b7406ff9ebb5 + size: 640035 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/9.yaml + original: lts-21.9