json-autotype (empty) → 0.2.0.0
raw patch · 10 files changed
+705/−0 lines, 10 filesdep +MissingHdep +aesondep +basesetup-changed
Dependencies added: MissingH, aeson, base, bytestring, containers, filepath, hashable, hflags, lens, mtl, text, uniplate, unordered-containers, vector
Files
- Data/Aeson/AutoType/Extract.hs +97/−0
- Data/Aeson/AutoType/Format.hs +239/−0
- Data/Aeson/AutoType/Type.hs +117/−0
- Data/Aeson/AutoType/Util.hs +11/−0
- GenerateJSONParser.hs +100/−0
- LICENSE +34/−0
- README.md +29/−0
- Setup.hs +2/−0
- changelog +13/−0
- json-autotype.cabal +63/−0
+ Data/Aeson/AutoType/Extract.hs view
@@ -0,0 +1,97 @@+module Data.Aeson.AutoType.Extract(valueSize, typeSize, valueTypeSize,+ valueDepth, Dict(..),+ Type(..), emptyType,+ extractType, unifyTypes) where++import Control.Exception (assert)+import Data.Aeson.AutoType.Type+import Control.Lens.TH+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.HashMap.Strict as Hash+import qualified Data.Set as Set+import qualified Data.Vector as V+import Data.Data (Data(..))+import Data.Typeable (Typeable(..))+import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import Data.Set (Set )+import Data.HashMap.Strict(HashMap)+import Data.List (sort, foldl1')+import Data.Ord (Ord(..), comparing)++valueSize :: Value -> Int+valueSize Null = 1+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 . Hash.elems $ o++valueTypeSize :: Value -> Int+valueTypeSize Null = 1+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 . Hash.elems $ o++valueDepth :: Value -> Int+valueDepth Null = 1+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 . Hash.elems $ o++extractType :: Value -> Type+extractType (Object o) = TObj $ Dict $ Hash.map extractType o+extractType Null = TNull+extractType (Bool b) = TBool+extractType (Number n) = TNum+extractType (String s) = TString+extractType (Array a) | V.null a = TArray emptyType+extractType (Array a) = V.foldl1' unifyTypes $ V.map extractType a++simplifyUnion :: Type -> Type+simplifyUnion (TUnion s) | Set.size s == 1 = head $ Set.toList s+simplifyUnion t = t++unifyTypes :: Type -> Type -> Type+unifyTypes TBool TBool = TBool+unifyTypes TNum TNum = TNum+unifyTypes TString TString = TString+unifyTypes TNull TNull = TNull+unifyTypes (TObj d) (TObj e) = TObj newDict + where+ newDict :: Dict+ newDict = Dict $ Hash.fromList [(k, get k d `unifyTypes`+ get k e) | k <- allKeys ]+ allKeys :: [Text]+ allKeys = Set.toList (keys d `Set.union` keys e)+unifyTypes (TArray u) (TArray v) = TArray $ u `unifyTypes` v+unifyTypes t s = typeAsSet t `unifyUnion` typeAsSet s++unifyUnion :: Set Type -> Set Type -> Type+unifyUnion u v = assertions $+ union $ uSimple `Set.union`+ vSimple `Set.union`+ oset+ where+ (uSimple, uCompound) = Set.partition isSimple u+ (vSimple, vCompound) = Set.partition isSimple v+ assertions = assert (Set.null $ Set.filter (not . isArray) uArr) .+ assert (Set.null $ Set.filter (not . isArray) vArr) + (uObj, uArr) = Set.partition isObject uCompound+ (vObj, vArr) = Set.partition isObject vCompound+ oset = Set.fromList $ if null objects+ then []+ else [foldl1' unifyTypes objects]+ aset = Set.fromList $ if null arrays+ then []+ else [foldl1' unifyTypes arrays]+ objects = Set.toList $ uObj `Set.union` vObj+ arrays = Set.toList $ uArr `Set.union` vArr++union = simplifyUnion . TUnion+
+ Data/Aeson/AutoType/Format.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, OverloadedStrings #-}+module Data.Aeson.AutoType.Format(+ displaySplitTypes, splitTypeByLabel, unificationCandidates,+ unifyCandidates+) where++import Control.Arrow ((&&&))+import Control.Lens.TH+import Control.Lens+import Control.Monad (forM, forM_)+import Control.Exception(assert)+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.HashMap.Strict as Map+import qualified Data.Set as Set+import qualified Data.Vector as V+import Data.Aeson+import Data.Aeson.Types+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.Text (Text)+import Data.Set (Set )+import Data.List (sort, foldl1')+import Data.Ord (Ord(..), comparing)+import Data.Char (isAlpha)+--import Data.Tuple.Utils (fst3)+import Control.Monad.State.Class+import Control.Monad.State.Strict(State, runState)+import Data.Hashable (Hashable(..))+import qualified Data.Graph as Graph++import Data.Aeson.AutoType.Type+import Data.Aeson.AutoType.Extract+import Data.Aeson.AutoType.Util++fst3 (a, _b, _c) = a++data DeclState = DeclState { _decls :: [Text]+ , _counter :: Int+ }+ deriving (Eq, Show, Ord)++makeLenses ''DeclState++type DeclM = State DeclState++type Map k v = Map.HashMap k v ++stepM :: DeclM Int+stepM = counter %%= (\i -> (i, i+1))++tShow :: (Show a) => a -> Text+tShow = Text.pack . show ++wrapDecl identifier contents = Text.unlines [header, contents, " } deriving (Show,Eq)"+ ,"\nderiveJSON defaultOptions ''" `Text.append` identifier]+ where+ header = Text.concat ["data ", identifier, " = ", identifier, " { "]++-- | Makes a generic identifier name.+genericIdentifier = do+ i <- stepM+ return $! "Obj" `Text.append` tShow i++-- * Naive type printing.+newDecl :: Text -> [(Text, Type)] -> DeclM Text+newDecl identifier kvs = do attrs <- forM kvs $ \(k, v) -> do+ formatted <- formatType' v+ return (k, formatted)+ let decl = wrapDecl identifier $ fieldDecls attrs+ decls %%= (\ds -> ((), decl:ds))+ return identifier+ where+ fieldDecls attrList = Text.intercalate ",\n" $ map fieldDecl attrList+ fieldDecl :: (Text, Text) -> Text+ fieldDecl (name, fType) = Text.concat [" ", normalizeFieldName identifier name, " :: ", fType]++normalizeFieldName identifier = escapeKeywords .+ uncapitalize .+ (normalizeTypeName identifier `Text.append`) .+ normalizeTypeName++keywords = Set.fromList ["type", "data", "module"]++escapeKeywords k | k `Set.member` keywords = k `Text.append` "_"+escapeKeywords k = k++emptySetLikes = Set.fromList [TNull, TArray $ TUnion $ Set.fromList []]++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) | uu <- u `Set.difference` emptySetLikes,+ Set.size uu == 1 = do fmt <- formatType' $ head $ Set.toList uu+ return $ "Maybe " `Text.append` fmt+formatType' (TUnion u) = do tys <- forM (Set.toList u) formatType'+ return $ mkUnion tys+ where+ mkUnion [] = emptyTypeRepr+ mkUnion nonEmpty = foldr1 mkEither nonEmpty+ where mkEither a b = Text.concat ["Either (", a, ") (", b, ")"]+formatType' (TArray a) = do inner <- formatType' a+ return $ Text.concat ["[", inner, "]"]+formatType' (TObj o) = do ident <- genericIdentifier+ newDecl ident d+ where+ d = Map.toList $ unDict o +formatType' e | e `Set.member` emptySetLikes = return emptyTypeRepr+formatType' t = return $ "ERROR: Don't know how to handle: " `Text.append` tShow t++emptyTypeRepr = "Maybe Text" -- default...++formatType = runDecl . formatType'++runDecl decl = Text.unlines $ finalState ^. decls+ where+ initialState = DeclState [] 1+ (_, finalState) = runState decl initialState++-- * Splitting object types by label for unification.+type TypeTree = Map Text [Type]++type TypeTreeM a = State TypeTree a++addType :: Text -> Type -> TypeTreeM ()+addType label typ = modify $ Map.insertWith (++) label [typ]++splitTypeByLabel' :: Text -> Type -> TypeTreeM Type+splitTypeByLabel' l TString = return TString+splitTypeByLabel' l TNum = return TNum+splitTypeByLabel' l TBool = return TBool+splitTypeByLabel' l TNull = return TNull+splitTypeByLabel' l (TLabel r) = assert False $ return $ TLabel r -- unnecessary?+splitTypeByLabel' l (TUnion u) = do m <- mapM (splitTypeByLabel' l) $ Set.toList u+ return $! TUnion $! Set.fromList m+splitTypeByLabel' l (TArray a) = do m <- splitTypeByLabel' (l `Text.append` "Elt") a+ return $! TArray m+splitTypeByLabel' l (TObj o) = do kvs <- forM d $ \(k, v) -> do+ component <- splitTypeByLabel' k v+ return (k, component)+ addType l (TObj $ Dict $ Map.fromList kvs)+ return $! TLabel l+ where+ d = Map.toList $ unDict o +--splitTypeByLabel' l t = error $ "ERROR: Don't know how to handle: " ++ show t++splitTypeByLabel :: Text -> Type -> Map Text Type+splitTypeByLabel topLabel t = Map.map (foldl1' unifyTypes) finalState+ where+ job = splitTypeByLabel' topLabel t+ -- addType topLabel r+ initialState = Map.empty+ (_, finalState) = runState job initialState++formatObjectType identifier (TObj o) = newDecl identifier d+ where+ d = Map.toList $ unDict o+formatObjectType identifier other = formatType' other++displaySplitTypes dict = runDecl decls+ where+ decls =+ forM (toposort dict) $ \(name, typ) -> do+ let name' = normalizeTypeName name+ formatObjectType name' typ++normalizeTypeName :: Text -> Text+normalizeTypeName = escapeKeywords .+ Text.concat .+ map capitalize .+ filter (not . Text.null) .+ Text.split (not . isAlpha)++capitalize :: Text -> Text+capitalize word = Text.toUpper first `Text.append` rest+ where+ (first, rest) = Text.splitAt 1 word++uncapitalize :: Text -> Text+uncapitalize word = Text.toLower first `Text.append` rest+ where+ (first, rest) = Text.splitAt 1 word++-- | Topological sorting of splitted types so that it is accepted declaration order.+toposort :: Map Text Type -> [(Text, Type)] +toposort splitted = map ((id &&& (splitted Map.!)) . fst3 . graphKey) $ Graph.topSort graph+ where+ (graph, graphKey) = Graph.graphFromEdges' $ map makeEntry $ Map.toList splitted+ makeEntry (k, v) = (k, k, allLabels v)++-- | Computes all type labels referenced by a given type.+allLabels :: Type -> [Text]+allLabels = flip go []+ where+ go (TLabel l) ls = l:ls+ go (TArray t) ls = go t ls+ go (TUnion u) ls = Set.foldr go ls u+ go (TObj o) ls = Map.foldr go ls $ unDict o+ go other ls = ls++-- * Finding candidates for extra unifications+-- | For a given splitted types, it returns candidates for extra+-- unifications.+unificationCandidates = Map.elems .+ Map.filter candidates .+ Map.fromListWith (++) .+ map entry .+ Map.toList+ where+ candidates [ ] = False+ candidates [a] = False+ candidates _ = True+ entry (k, TObj o) = (Set.fromList $ Map.keys $ unDict o, [k])+ entry (_, other ) = error $ "Unexpected type: " ++ show other++-- | Unifies candidates on a give input list.+unifyCandidates :: [[Text]] -> Map Text Type -> Map Text Type+unifyCandidates candidates splitted = Map.map (remapLabels labelMapping) $ replacements splitted+ where+ unifiedType :: [Text] -> Type+ unifiedType cset = foldr1 unifyTypes $ + map (splitted Map.!) cset+ replace :: [Text] -> Map Text Type -> Map Text Type+ replace cset@(c:_) s = Map.insert c (unifiedType cset) (foldr Map.delete s cset)+ replacements :: Map Text Type -> Map Text Type+ replacements s = foldr replace s candidates+ labelMapping :: Map Text Text+ labelMapping = Map.fromList $ concatMap mapEntry candidates+ mapEntry cset@(c:_) = [(x, c) | x <- cset]++-- | Remaps type labels according to a `Map`.+remapLabels :: Map Text Text -> Type -> Type+remapLabels ls (TObj o) = TObj $ Dict $ Map.map (remapLabels ls) $ unDict o+remapLabels ls (TArray t) = TArray $ remapLabels ls t+remapLabels ls (TUnion u) = TUnion $ Set.map (remapLabels ls) u+remapLabels ls (TLabel l) = TLabel $ Map.lookupDefault l l ls+remapLabels ls other = other+
+ Data/Aeson/AutoType/Type.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Data.Aeson.AutoType.Type(typeSize,+ Dict(..), keys, get, withDict,+ Type(..), emptyType,+ isSimple, isArray, isObject, typeAsSet,+ hasNonTopTObj,+ hasTObj) where++import Control.Lens.TH+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.HashMap.Strict as Hash+import qualified Data.Set as Set+import qualified Data.Vector as V+import Data.Data (Data(..))+import Data.Typeable (Typeable(..))+import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import Data.Set (Set )+import Data.HashMap.Strict(HashMap)+import Data.List (sort, foldl1')+import Data.Ord (Ord(..), comparing)+import Data.Generics.Uniplate++-- | Type alias for HashMap+type Map = HashMap++-- * Dictionary of types indexed by names.+newtype Dict = Dict { unDict :: Map Text Type }+ deriving (Eq, Data, Typeable)++instance Show Dict where+ show = show . sort . Hash.toList . unDict++instance Ord Dict where+ compare = comparing $ sort . Hash.toList . unDict++-- | Make operation on a map to an operation on a Dict.+f `withDict` (Dict m) = Dict $ f m++-- | Take all keys from dictionary.+keys :: Dict -> Set Text+keys = Set.fromList . Hash.keys . unDict++-- * Type+data Type = TNull | TBool | TNum | TString |+ TUnion (Set Type) |+ TLabel Text |+ TObj Dict |+ TArray Type+ deriving (Show,Eq, Ord, Data, Typeable)++-- These are missing Uniplate instances...+{-+instance Biplate (Set a) a where+ biplate s = (Set.toList s, Set.fromList)++instance Biplate (HashMap k v) v where+ biplate m = (Hash.elems m, Hash.fromList . zip (Hash.keys m))+ -}++instance Uniplate Type where+ uniplate (TUnion s) = (Set.toList s, TUnion . Set.fromList )+ uniplate (TObj d) = (Hash.elems m, TObj . Dict . Hash.fromList . zip (Hash.keys m))+ where+ m = unDict d+ uniplate (TArray t) = ([t], TArray . head )+ uniplate s = ([], const s )++-- | Empty type+emptyType :: Type+emptyType = TUnion Set.empty ++-- | Lookup the Type within the dictionary.+get :: Text -> Dict -> Type+get key = Hash.lookupDefault emptyType key . unDict ++-- $derive makeUniplateDirect ''Type++-- | Size of the `Type` term.+typeSize TNull = 1+typeSize TBool = 1+typeSize TNum = 1+typeSize TString = 1+typeSize (TObj o) = (1+) . sum . map typeSize . Hash.elems . unDict $ o+typeSize (TArray a) = 1 + typeSize a+typeSize (TUnion u) = (1+) . maximum . (0:) . map typeSize . Set.toList $ u++typeAsSet t@(TUnion s) = s+typeAsSet t = Set.singleton t++hasTObj, hasNonTopTObj, isArray, isUnion, isSimple, isObject :: Type -> Bool+-- | Is the top-level constructor a TObj?+isObject (TObj _) = True+isObject _ = False++-- | Is it a simple (non-compound) Type?+isSimple x = not (isObject x) && not (isArray x) && not (isUnion x)++-- | Is the top-level constructor a TUnion?+isUnion (TUnion _) = True+isUnion _ = False++-- | Is the top-level constructor a TArray?+isArray (TArray _) = True+isArray _ = False++hasNonTopTObj (TObj o) = any hasTObj $ Hash.elems $ unDict o+hasNonTopTObj other = False++hasTObj (TObj _) = True+hasTObj (TArray a) = hasTObj a+hasTObj (TUnion u) = any u+ where+ any = Set.foldr ((||) . hasTObj) False+hasTObj _ = False+
+ Data/Aeson/AutoType/Util.hs view
@@ -0,0 +1,11 @@+module Data.Aeson.AutoType.Util where++import Data.Hashable+import qualified Data.Set as Set++-- Missing instances+instance Hashable a => Hashable (Set.Set a) where+ hashWithSalt = Set.foldr (flip hashWithSalt)++ +
+ GenerateJSONParser.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Main where++import System.IO (withFile, stderr, stdout, IOMode(WriteMode), Handle)+import System.FilePath (FilePath, splitExtension)+import System.Environment (getArgs)+import Control.Arrow ((&&&))+import Control.Lens.TH+import Control.Lens+import Control.Monad (forM, forM_, when)+import Control.Exception(assert)+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.HashMap.Strict as Map+import qualified Data.Set as Set+import qualified Data.Vector as V+import Data.Aeson+import Data.Aeson.Types+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.Text (Text)+import Data.Set (Set )+import Data.List (sort, foldl1')+import Data.Ord (Ord(..), comparing)+import Data.Char (isAlpha)+import Control.Monad.State.Class+import Control.Monad.State.Strict(State, runState)+import Data.Hashable (Hashable(..))+import qualified Data.Graph as Graph++import Data.Aeson.AutoType.Type+import Data.Aeson.AutoType.Extract+import Data.Aeson.AutoType.Util+import Data.Aeson.AutoType.Format+import HFlags++--import Data.Tuple.Utils (fst3)+fst3 (a, _, _) = a++assertM v = assert v $ return ()++capitalize :: Text -> Text+capitalize input = Text.toUpper (Text.take 1 input)+ `Text.append` Text.drop 1 input++header moduleName = Text.unlines ["{-# LANGUAGE TemplateHaskell #-}"+ ,Text.concat ["module ", capitalize moduleName, " where"]+ ,""+ ,"import Data.Text (Text)"+ ,"import Data.Aeson(decode, Value(..), FromJSON(..),"+ ," (.:), (.:?), (.!=))"+ ,"import Data.Aeson.TH"+ ,""]++-- * Command line flags+defineFlag "filename" ("JSONTypes.hs" :: FilePath) "Write output to the given file"+defineFlag "suggest" True "Suggest candidates for unification"+defineFlag "autounify" True "Automatically unify suggested candidates"+defineFlag "fakeFlag" True "Ignore this flag - it doesn't exist!!!"++-- | Generic function for opening file if the filename is not empty nor "-",+-- or using given handle otherwise (probably stdout, stderr, or stdin).+-- TODO: Should it become utility function?+withFileOrHandle :: FilePath -> IOMode -> Handle -> (Handle -> IO r) -> IO r+withFileOrHandle "" ioMode handle action = action handle+withFileOrHandle "-" ioMode handle action = action handle+withFileOrHandle name ioMode _ action = withFile name ioMode action ++-- Tracing is switched off:+myTrace :: String -> IO ()+myTrace _msg = return ()+--myTrace = putStrLn ++main = do filenames <- $initHFlags "json-autotype -- automatic type and parser generation from JSON"+ let (moduleName, extension) = splitExtension flags_filename+ assertM $ extension == ".hs"+ -- TODO: should integrate all inputs into single type set!!!+ withFileOrHandle flags_filename WriteMode stdout $ \hOut ->+ forM filenames $ \filename ->+ do bs <- BSL.readFile filename+ Text.hPutStrLn stderr $ "Processing " `Text.append` Text.pack (show moduleName)+ myTrace ("Decoded JSON: " ++ show (decode bs :: Maybe Value))+ let Just v = decode bs+ let t = extractType v+ myTrace $ "type: " ++ show t+ let splitted = splitTypeByLabel "TopLevel" t+ myTrace $ "splitted: " ++ show splitted+ Text.hPutStrLn hOut $ header $ Text.pack moduleName+ assertM $ not $ any hasNonTopTObj $ Map.elems splitted+ let uCands = unificationCandidates splitted+ myTrace $ "candidates: " ++ show uCands+ when flags_suggest $ forM_ uCands $ \cs -> do+ putStr "-- "+ Text.putStrLn $ "=" `Text.intercalate` cs+ let unified = if flags_autounify+ then unifyCandidates uCands splitted+ else splitted+ myTrace $ "unified: " ++ show unified+ Text.hPutStrLn hOut $ displaySplitTypes unified+
+ LICENSE view
@@ -0,0 +1,34 @@+This repository contains some test JSON examples in test/*.json+that is downloaded from Twitter API and http://www.jquery4u.com/json/.+Naturally these are covered by other licenses.++Code copyright (c) 2014, Michal J. Gajda++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michal J. Gajda nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,29 @@+json-autotype+=============+Takes a JSON format input, and generates automatic Haskell type declarations.+*Goal is to also generate parser, and pretty-printer instances.*++It uses union type unification. Types inferred may be automatically trimmed and unified+using attribute set matching.++I should probably write a short paper to explain the methodology.++[](https://travis-ci.org/mgajda/json-autotype)+[](https://hackage.haskell.org/package/json-autotype)++Details on official releases will be on [Hackage](https://hackage.haskell.org/package/json-autotype)++USAGE:+======+After installing with `cabal install json-autotype`, you might generate stub code for the parser:++ json-autotype input.json -o MyFormat.hs++Then you might test the parser by running it on an input file:++ runghc MyFormat.hs input.json++If everything is correct, then feel free to inspect the data structure generated automatically for you!+The goal of this program is to make it easy for users of big JSON APIs to generate entries from+example data.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog view
@@ -0,0 +1,13 @@+-*-Changelog-*-++0.2.0 Oct 2014+ * First release to Hackage.+ * Handling of proper unions, and most examples.+ * Automatically tested on a wide range of example documents (see+ tests/)+ * Initial documentation in README.md.++0.1.0 July 2014+ * First experiments uploaded to GitHub, and discussed to+ HackerSpace.SG.+
+ json-autotype.cabal view
@@ -0,0 +1,63 @@+-- Build information for the package.+name: json-autotype+version: 0.2.0.0+synopsis: Automatic type declaration for JSON input data+description: Generates datatype declarations with Aeson's "FromJSON" instances+ from a set of example ".json" files.+ .+ To get started you need to install the package,+ and run "json-autotype" binary on an input ".json" file.+ That will generate a new Aeson-based JSON parser.+ .+ "$ json-autotype input.json -o JSONTypes.hs"+ .+ Feel free to tweak the by changing types of the fields+ - any field type that is instance of "FromJSON" should work.+ .+ You may immediately test the parser by calling it as a script:+ .+ "$ runghc JSONTypes.hs input.json"+ .+ See introduction on <https://github.com/mgajda/json-autotype>+ for details.+homepage: https://github.com/mgajda/json-autotype+license: BSD3+license-file: LICENSE+author: Michal J. Gajda+maintainer: mjgajda@gmail.com+copyright: Copyright by Michal J. Gajda '2014+category: Web+build-type: Simple+extra-source-files: README.md changelog+cabal-version: >=1.10+bug-reports: https://github.com/mgajda/json-autotype/issues++executable json-autotype+ main-is: GenerateJSONParser.hs+ other-modules: Data.Aeson.AutoType.Type+ Data.Aeson.AutoType.Util+ Data.Aeson.AutoType.Extract+ Data.Aeson.AutoType.Format+ other-extensions: TemplateHaskell,+ ScopedTypeVariables,+ OverloadedStrings,+ FlexibleInstances,+ MultiParamTypeClasses,+ DeriveDataTypeable+ build-depends: base >=4.3 && <4.8,+ lens >=4.1 && <4.2,+ bytestring >=0.9 && <0.11,+ unordered-containers >=0.2 && <0.3,+ containers >=0.3 && <0.6,+ vector >=0.9 && <0.11,+ aeson >=0.7 && <0.8,+ text >=1.1 && <1.2,+ hashable >=1.2 && <1.3,+ uniplate >=1.6 && <1.7,+ MissingH >=1.2 && <1.3,+ hflags >=0.4 && <0.5,+ filepath >=1.3 && <1.4,+ mtl >=2.1 && <2.2+ -- hs-source-dirs: + default-language: Haskell2010+