diff --git a/Data/Aeson/AutoType/Extract.hs b/Data/Aeson/AutoType/Extract.hs new file mode 100644 --- /dev/null +++ b/Data/Aeson/AutoType/Extract.hs @@ -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 + diff --git a/Data/Aeson/AutoType/Format.hs b/Data/Aeson/AutoType/Format.hs new file mode 100644 --- /dev/null +++ b/Data/Aeson/AutoType/Format.hs @@ -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 + diff --git a/Data/Aeson/AutoType/Type.hs b/Data/Aeson/AutoType/Type.hs new file mode 100644 --- /dev/null +++ b/Data/Aeson/AutoType/Type.hs @@ -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 + diff --git a/Data/Aeson/AutoType/Util.hs b/Data/Aeson/AutoType/Util.hs new file mode 100644 --- /dev/null +++ b/Data/Aeson/AutoType/Util.hs @@ -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) + + + diff --git a/GenerateJSONParser.hs b/GenerateJSONParser.hs new file mode 100644 --- /dev/null +++ b/GenerateJSONParser.hs @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. + +[![Build Status](https://api.travis-ci.org/mgajda/json-autotype.png?branch=master)](https://travis-ci.org/mgajda/json-autotype) +[![Hackage](https://budueba.com/hackage/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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -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. + diff --git a/json-autotype.cabal b/json-autotype.cabal new file mode 100644 --- /dev/null +++ b/json-autotype.cabal @@ -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 + 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 +