diff --git a/app/Flags.hs b/app/Flags.hs new file mode 100644 --- /dev/null +++ b/app/Flags.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} +module Flags where + +import Options.Applicative +import JsonToHaskell +import Text.RawString.QQ (r) +import Text.PrettyPrint.ANSI.Leijen + +optionsParserInfo :: ParserInfo Options +optionsParserInfo = info (optionParser <**> helper) fullDesc + +parseNumberType :: ReadM NumberType +parseNumberType = maybeReader $ \case + "smart-floats" -> Just UseSmartFloats + "smart-doubles" -> Just UseSmartDoubles + "floats" -> Just UseFloats + "doubles" -> Just UseDoubles + _ -> Nothing + +parseTextType :: ReadM TextType +parseTextType = maybeReader $ \case + "string" -> Just UseString + "text" -> Just UseText + "bytestring" -> Just UseByteString + _ -> Nothing + +parseMapType :: ReadM MapType +parseMapType = maybeReader $ \case + "map" -> Just UseMap + "hashmap" -> Just UseHashMap + _ -> Nothing + +parseListType :: ReadM ListType +parseListType = maybeReader $ \case + "list" -> Just UseList + "vector" -> Just UseVector + _ -> Nothing + +stringDoc :: String -> Mod f a +stringDoc = helpDoc . Just . string + +optionParser :: Parser Options +optionParser = do + _tabStop <- option auto + (short 't' + <> long "tab-stop" + <> stringDoc "Number of spaces to indent each level." + <> value 2) + _numberType <- option parseNumberType + (short 'n' + <> long "numbers" + <> value UseSmartDoubles + <> stringDoc [r|Type to use for numbers. + +'smart-floats': + Use floats for numbers with decimals, Int for whole numbers. +'smart-doubles': + Use floats for numbers with decimals, Int for whole numbers. +'floats': + Use floats for all numbers. +'doubles': + Use doubles for all numbers. +'scientific': + Use scientific for all numbers. +|]) + _textType <- option parseTextType + (short 's' + <> long "strings" + <> value UseText + <> stringDoc [r|Type to use for strings. + +'string': + Use String for strings. +'text': + Use Text for strings. +'bytestring': + Use ByteString for strings. +|]) + _mapType <- option parseMapType + (short 'm' + <> long "maps" + <> value UseMap + <> stringDoc [r|Type to use for maps. + +'map': + Use Data.Map for maps. +'hashmap': + Use Data.HashMap for maps. +|]) + _listType <- option parseListType + (short 'l' + <> long "lists" + <> value UseList + <> stringDoc [r|Type to use for lists. + +'list': + Use [] for lists. +'vector': + Use Data.Vector for lists. +|]) + _includeHeader <- flag True False + (long "no-module-header" + <> stringDoc [r|Omit the module header containing language extensions, module definition and imports.|]) + _strictData <- flag False True + (long "strict" + <> stringDoc [r|Use strict record fields.|]) + pure $ Options {.. } diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,39 +4,17 @@ module Main where import JsonToHaskell -import Data.Aeson hiding (defaultOptions) -import Text.RawString.QQ (r) -import Data.Text.IO as T -import Data.ByteString.Lazy as BS - -value :: Either String Value -value = eitherDecode valueStr - -valueStr :: BS.ByteString -valueStr = [r| -{ - "name": "jon", - "age and stuff": 37, - "is-employed": true, - "\"pets_maybe": [["Garfield"], ["Odie"]], - "address": { - "street": "221B", - "zip": 12345, - "other" : { - "one": 1 - } - }, - "other-address": { - "street": "221B", - "zip2": 12345, - "other" : { - "two": [{}] - } - } -} -|] +import qualified Data.Text.IO as T +import qualified Data.ByteString.Lazy as BL +import Options.Applicative +import System.Exit +import Flags +import Data.Aeson main :: IO () main = do - v <- either fail pure value - T.putStrLn $ jsonToHaskell defaultOptions v + opts <- execParser optionsParserInfo + input <- BL.getContents + case eitherDecode input of + Left err -> putStrLn err >> exitWith (ExitFailure 1) + Right val -> T.putStrLn $ jsonToHaskell opts val diff --git a/json-to-haskell.cabal b/json-to-haskell.cabal --- a/json-to-haskell.cabal +++ b/json-to-haskell.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 1079a1406cdee3bc2efef1e996c7a1567e6e39d4c155e7edbaafb79a86a52880 +-- hash: ccb186e695b31c1b3ebeb957e8b52dc2a25db22eac621ea58f87a819385927f5 name: json-to-haskell -version: 0.0.1.0 +version: 0.1.0.0 description: Please see the README on GitHub at homepage: https://github.com/githubuser/json-to-haskell#readme bug-reports: https://github.com/githubuser/json-to-haskell/issues @@ -55,6 +55,7 @@ executable json-to-haskell-exe main-is: Main.hs other-modules: + Flags Paths_json_to_haskell hs-source-dirs: app @@ -62,6 +63,7 @@ build-depends: aeson , aeson-extra + , ansi-wl-pprint , base >=4.7 && <5 , bimap , bytestring @@ -71,6 +73,7 @@ , microlens-platform , mtl , nonempty-containers + , optparse-applicative , raw-strings-qq , recursion-schemes , text diff --git a/src/JsonToHaskell.hs b/src/JsonToHaskell.hs --- a/src/JsonToHaskell.hs +++ b/src/JsonToHaskell.hs @@ -11,8 +11,13 @@ {-# LANGUAGE TypeApplications #-} module JsonToHaskell ( jsonToHaskell + , simpleOptions + , performantOptions , Options(..) - , defaultOptions + , NumberType(..) + , TextType(..) + , MapType(..) + , ListType(..) ) where import JsonToHaskell.Internal.Options @@ -22,6 +27,10 @@ import qualified Data.Text as T import qualified Data.Bimap as BM +-- | Transform an Aeson 'Value' into a complete Haskell module (as 'T.Text'). +-- This function is all that you need. +-- +-- Use 'defaultOptions' as a reasonable starting point. jsonToHaskell :: Options -> Value -> T.Text jsonToHaskell opts v = do let allStructs = analyze v diff --git a/src/JsonToHaskell/Internal/Options.hs b/src/JsonToHaskell/Internal/Options.hs --- a/src/JsonToHaskell/Internal/Options.hs +++ b/src/JsonToHaskell/Internal/Options.hs @@ -3,76 +3,87 @@ import Lens.Micro.Platform (makeLenses) -data NumberPreference = - SmartFloats - | SmartDoubles - | FloatNumbers - | DoubleNumbers - | ScientificNumbers +-- | Choose which type to use for Numbers +data NumberType = + -- | Use 'Int' for whole numbers, 'Float' for decimals + UseSmartFloats + -- | Use 'Int' for whole numbers, 'Double' for decimals + | UseSmartDoubles + -- | Use 'Float' for all numbers + | UseFloats + -- | Use 'Double' for all numbers + | UseDoubles + -- | Use 'Scientific' for all numbers + | UseScientificNumbers deriving (Show, Eq) +-- | Choose which type to use for strings data TextType = + -- | Use 'String' for strings UseString + -- | Use 'Text' for string | UseText + -- | Use 'ByteString' for strings | UseByteString deriving (Show, Eq) +-- | Choose which type to use for key-value maps data MapType = + -- | Use Data.Map UseMap + -- | Use Data.HashMap | UseHashMap deriving (Show, Eq) +-- | Choose which type to use for arrays data ListType = + -- | Use lists UseList + -- | Use vectors | UseVector deriving (Show, Eq) +-- | Options for module generation data Options = Options { _tabStop :: Int - , _numberPreference :: NumberPreference + , _numberType :: NumberType , _textType :: TextType , _mapType :: MapType , _listType :: ListType - , _includeImports :: Bool - , _stronglyNormalize :: Bool + , _includeHeader :: Bool + -- , _stronglyNormalize :: Bool , _strictData :: Bool } -data Env = Env - { _options :: Options - , _indentationLevel :: Int - } - makeLenses ''Options -makeLenses ''Env -defaultOptions :: Options -defaultOptions = Options +-- | Simple module generation options. +-- These are reasonable defaults for a simple module +simpleOptions :: Options +simpleOptions = Options { _tabStop = 2 - , _numberPreference = DoubleNumbers + , _numberType = UseDoubles , _textType = UseText , _mapType = UseMap , _listType = UseList - , _includeImports = False - , _stronglyNormalize = True + , _includeHeader = False + -- , _stronglyNormalize = True , _strictData = False } +-- | Use more performant data types, use these for production apps. performantOptions :: Options performantOptions = Options { _tabStop = 2 - , _numberPreference = DoubleNumbers + , _numberType = UseDoubles , _textType = UseText , _mapType = UseMap , _listType = UseList - , _includeImports = False - , _stronglyNormalize = True + , _includeHeader = False -- TODO + -- , _stronglyNormalize = True , _strictData = True } - -data NumberType = Fractional | Whole - deriving (Show, Eq, Ord) diff --git a/src/JsonToHaskell/Internal/Parser.hs b/src/JsonToHaskell/Internal/Parser.hs --- a/src/JsonToHaskell/Internal/Parser.hs +++ b/src/JsonToHaskell/Internal/Parser.hs @@ -8,7 +8,6 @@ {-# LANGUAGE OverloadedStrings #-} module JsonToHaskell.Internal.Parser where -import JsonToHaskell.Internal.Options import Control.Monad.State import Control.Monad.Reader import Data.Aeson (Value) @@ -27,6 +26,10 @@ import qualified Data.Vector as V import qualified Data.Set as S +-- | Used to track whether the value was fractional or whole. +data NumberVariant = Fractional | Whole + deriving (Show, Eq, Ord) + -- a DataKind for tracking whether a structure contains nested structs or Record Names data RecordType = Ref | Structure -- | The representation of a record's field types @@ -38,7 +41,7 @@ SRecordRef :: T.Text -> Struct 'Ref SMap :: Struct r -> Struct r SBool :: Struct r - SNumber :: NumberType -> Struct r + SNumber :: NumberVariant -> Struct r SNull :: Struct r SString :: Struct r SValue :: Struct r diff --git a/src/JsonToHaskell/Internal/Printer.hs b/src/JsonToHaskell/Internal/Printer.hs --- a/src/JsonToHaskell/Internal/Printer.hs +++ b/src/JsonToHaskell/Internal/Printer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -6,6 +7,7 @@ {-# LANGUAGE GADTs #-} module JsonToHaskell.Internal.Printer where +import Lens.Micro.Platform (makeLenses) import JsonToHaskell.Internal.Parser import JsonToHaskell.Internal.Options import Control.Monad.State @@ -21,6 +23,15 @@ import Lens.Micro.Platform (view, (+~), (<&>)) +-- | The environment used for printing the module +data Env = Env + { _options :: Options + , _indentationLevel :: Int + } +makeLenses ''Env + + + -- | Convert a name into a valid haskell field name toFieldName :: T.Text -> T.Text toFieldName = T.filter (isAlphaNum) . T.pack . toCamel . fromAny . T.unpack . T.dropWhile (not . isAlpha) @@ -66,7 +77,9 @@ else tell ", " tell $ toFieldName k tell " :: " - buildType v + useStrictData <- view (options . strictData) + when useStrictData (tell "!") + writeType False v indented . line $ do tell "} " tell "deriving (Show, Eq, Ord)" @@ -113,29 +126,37 @@ -- | Write out the Haskell representation for a given JSON type -buildType :: Struct 'Ref -> Builder () -buildType = - \case - SNull -> tell "()" +writeType :: Bool -> Struct 'Ref -> Builder () +writeType nested struct = do + strict <- view (options . strictData) + let wrapOuter = if strict || nested then parens else id + case struct of + SNull -> wrapOuter $ tell "Maybe Value" SString -> do getTextType >>= tell SNumber t -> do - pref <- view (options . numberPreference) + pref <- view (options . numberType) case (pref, t) of - (FloatNumbers, _) -> tell "Float" - (DoubleNumbers, _) -> tell "Double" - (ScientificNumbers, _) -> tell "Scientific" - (SmartFloats, Fractional) -> tell "Float" - (SmartFloats, Whole) -> tell "Int" - (SmartDoubles, Fractional) -> tell "Double" - (SmartDoubles, Whole) -> tell "Int" + (UseFloats, _) -> tell "Float" + (UseDoubles, _) -> tell "Double" + (UseScientificNumbers, _) -> tell "Scientific" + (UseSmartFloats, Fractional) -> tell "Float" + (UseSmartFloats, Whole) -> tell "Int" + (UseSmartDoubles, Fractional) -> tell "Double" + (UseSmartDoubles, Whole) -> tell "Int" SBool -> tell "Bool" SValue -> tell "Value" SMap s -> do txtType <- getTextType - tell ("Map " <> txtType <> " ") >> parens (buildType s) - SArray s -> tell "Vector " >> parens (buildType s) + mapStr <- view (options . mapType) <&> \case + UseMap -> "Map" + UseHashMap -> "HashMap" + wrapOuter $ tell (mapStr <> " " <> txtType <> " ") >> writeType True s + SArray s -> do + view (options . listType) >>= \case + UseList -> tell "[" >> writeType True s >> tell "]" + UseVector -> wrapOuter $ tell "Vector " >> writeType True s SRecordRef n -> tell n where getTextType = do