json-autotype 0.3 → 0.4
raw patch · 8 files changed
+50/−28 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Data/Aeson/AutoType/CodeGen.hs +1/−0
- Data/Aeson/AutoType/Format.hs +17/−12
- Data/Aeson/AutoType/Test.hs +6/−2
- Data/Aeson/AutoType/Type.hs +13/−7
- GenerateJSONParser.hs +5/−4
- GenerateTestJSON.hs +1/−1
- changelog.md +4/−0
- json-autotype.cabal +3/−2
Data/Aeson/AutoType/CodeGen.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+-- | Wrappers for generating prologue and epilogue code in Haskell. module Data.Aeson.AutoType.CodeGen( writeHaskellModule , defaultOutputFilename
Data/Aeson/AutoType/Format.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGuaGE DeriveGeneric #-} {-# LANGuaGE FlexibleContexts #-}+-- | Formatting type declarations and class instances for inferred types. module Data.Aeson.AutoType.Format( displaySplitTypes, splitTypeByLabel, unificationCandidates, unifyCandidates@@ -158,19 +159,22 @@ escapeKeywords k | k `Set.member` keywords = k `Text.append` "_" escapeKeywords k = k +-- | Format the type within DeclM monad, that records+-- the separate declarations on which this one is dependent. formatType :: Type -> DeclM Text-formatType TString = return "Text"-formatType TNum = return "Int"-formatType TBool = return "Bool"-formatType (TLabel l) = return $ normalizeTypeName l-formatType (TUnion u) | (TNull==) `any` u = do fmt <- formatType $ head $ Set.toList $ Set.filter (TNull /=) u- return $ Text.concat ["Maybe (", fmt, ")"]-formatType (TUnion u) = do tys <- forM (Set.toList u) formatType- return $ mkUnion tys+formatType TString = return "Text"+formatType TNum = return "Int"+formatType TBool = return "Bool"+formatType (TLabel l) = return $ normalizeTypeName l+formatType (TUnion u) = wrap <$> case length nonNull of+ 0 -> return emptyTypeRepr+ 1 -> formatType $ head nonNull+ _ -> Text.intercalate ":|:" <$> mapM formatType nonNull where- mkUnion [] = emptyTypeRepr- mkUnion nonEmpty = foldr1 mkEither nonEmpty- where mkEither a b = Text.concat [a, " :|: ", b]+ nonNull = Set.toList $ Set.filter (TNull /=) u+ wrap :: Text -> Text+ wrap inner | TNull `Set.member` u = Text.concat ["(Maybe (", inner, "))"]+ | otherwise = inner formatType (TArray a) = do inner <- formatType a return $ Text.concat ["[", inner, "]"] formatType (TObj o) = do ident <- genericIdentifier@@ -181,7 +185,7 @@ formatType t = return $ "ERROR: Don't know how to handle: " `Text.append` tShow t emptyTypeRepr :: Text-emptyTypeRepr = "Maybe Value" -- default, accepts future extension where we found no data+emptyTypeRepr = "(Maybe Value)" -- default, accepts future extension where we found no data runDecl :: DeclM a -> Text runDecl decl = Text.unlines $ finalState ^. decls@@ -228,6 +232,7 @@ d = Map.toList $ unDict o formatObjectType identifier other = newAlias identifier other +-- | Display an environment of types split by name. displaySplitTypes :: Map Text Type -> Text displaySplitTypes dict = trace ("displaySplitTypes: " ++ show (toposort dict)) $ runDecl declarations where
Data/Aeson/AutoType/Test.hs view
@@ -10,6 +10,7 @@ import Control.Applicative ((<$>), (<*>)) import Data.Aeson import Data.Function (on)+import Data.Hashable (Hashable) import Data.Generics.Uniplate.Data import Data.List import Data.Scientific@@ -36,6 +37,7 @@ -- | Helper function for generating Arbitrary and Series instances -- for @Data.HashMap.Strict.Map@ from lists of pairs.+makeMap :: (Ord a, Hashable a) =>[(a, b)] -> Map.HashMap a b makeMap = Map.fromList . nubBy ((==) `on` fst) . sortBy (compare `on` fst)@@ -58,12 +60,14 @@ shrink = concatMap simpleShrink . universe -simpleShrink :: Value -> [Value]+-- | 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 _ = [] -- Nothing for simple objects --- | Generators of compound structures: object and array.+-- | Generator for compound @Value@s+complexGens :: Int -> [Gen Value] complexGens i = [Object . Map.fromList <$> resize i arbitrary, Array <$> resize i arbitrary]
Data/Aeson/AutoType/Type.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-{-# LANGUAGE ViewPatterns, OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Union types describing JSON objects, and operations for querying these types. module Data.Aeson.AutoType.Type(typeSize, Dict(..), keys, get, withDict, Type(..), emptyType,@@ -8,7 +12,8 @@ hasNonTopTObj, hasTObj, isNullable,- emptySetLikes) where+ emptySetLikes+ ) where import Prelude hiding (any) import qualified Data.HashMap.Strict as Hash@@ -28,10 +33,11 @@ import Data.Aeson.AutoType.Pretty +-- * Dictionary types for overloading of usual class instances. -- | Type alias for HashMap type Map = HashMap --- * Dictionary of types indexed by names.+-- | Dictionary of types indexed by names. newtype Dict = Dict { unDict :: Map Text Type } deriving (Eq, Data, Typeable, Generic) @@ -53,7 +59,7 @@ keys :: Dict -> Set Text keys = Set.fromList . Hash.keys . unDict --- * Type+-- | Union types for JSON values. data Type = TNull | TBool | TNum | TString | TUnion (Set Type) | TLabel Text |@@ -91,7 +97,7 @@ -- $derive makeUniplateDirect ''Type -- | Size of the `Type` term.-typeSize :: Type -> Int+typeSize :: Type -> Int typeSize TNull = 1 typeSize TBool = 1 typeSize TNum = 1
GenerateJSONParser.hs view
@@ -32,9 +32,6 @@ import Data.Aeson.AutoType.Util import HFlags -fst3 :: (t, t1, t2) -> t-fst3 (a, _, _) = a- -- * Command line flags defineFlag "o:outputFilename" defaultOutputFilename "Write output to the given file" defineFlag "suggest" True "Suggest candidates for unification"@@ -44,7 +41,7 @@ defineFlag "y:typecheck" True "Set this flag to typecheck after unification" defineFlag "fakeFlag" True "Ignore this flag - it doesn't exist!!! It is workaround to library problem." --- Tracing is switched off:+-- | Works like @Debug.trace@ when the --debug flag is enabled, and does nothing otherwise. myTrace :: String -> IO () myTrace msg = if flags_debug then putStrLn msg@@ -59,6 +56,9 @@ fatal msg = do report msg exitFailure +-- | Extracts type from JSON file, along with the original @Value@.+-- In order to facilitate dealing with failures, it returns a triple of+-- @FilePath@, extracted @Type@, and a JSON @Value@. extractTypeFromJSONFile :: FilePath -> IO (Maybe (FilePath, Type, Value)) extractTypeFromJSONFile inputFilename = withFileOrHandle inputFilename ReadMode stdin $ \hIn ->@@ -125,6 +125,7 @@ when flags_test $ exitWith =<< system (unwords $ ["runghc", outputFilename] ++ passedTypeCheck) +-- | Initialize flags, and run @generateHaskellFromJSONs@. main :: IO () main = do filenames <- $initHFlags "json-autotype -- automatic type and parser generation from JSON" -- TODO: should integrate all inputs into single type set!!!
GenerateTestJSON.hs view
@@ -156,7 +156,7 @@ writeHaskellModule outputFilename unified if flags_test then do- r <- (==ExitSuccess) <$> system (unwords $ ["runghc", outputFilename] ++ inputFilenames)+ r <- (==ExitSuccess) <$> system (unwords $ ["runghc", outputFilename, inputFilename]) when r $ mapM_ removeFile [inputFilename, outputFilename] return r else
changelog.md view
@@ -1,5 +1,9 @@ Changelog =========+ 0.4 Apr 2015++ * Release candidate for current functionality.+ 0.3 Apr 2015 * Passed all smallcheck/quickcheck tests.
json-autotype.cabal view
@@ -1,6 +1,6 @@ -- Build information for the package. name: json-autotype-version: 0.3+version: 0.4 synopsis: Automatic type declaration for JSON input data description: Generates datatype declarations with Aeson's "FromJSON" instances from a set of example ".json" files.@@ -110,7 +110,8 @@ default-language: Haskell2010 -- test suites-executable json-autotype-random-test+test-suite json-autotype-random-test+ type: exitcode-stdio-1.0 main-is: GenerateTestJSON.hs other-modules: Data.Aeson.AutoType.Util, Data.Aeson.AutoType.Test,