json-to-haskell 0.0.1.0 → 0.1.0.0

raw patch · 7 files changed

+214/−79 lines, 7 filesdep +ansi-wl-pprintdep +optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-wl-pprint, optparse-applicative

API changes (from Hackage documentation)

Files

• app/Flags.hs +110/−0
• app/Main.hs +11/−33
• json-to-haskell.cabal +5/−2
• src/JsonToHaskell.hs +10/−1
• src/JsonToHaskell/Internal/Options.hs +37/−26
• src/JsonToHaskell/Internal/Parser.hs +5/−2
• src/JsonToHaskell/Internal/Printer.hs +36/−15

@@ -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 {.. }

@@ -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

@@ -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 <https://github.com/githubuser/json-to-haskell#readme> 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

@@ -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

@@ -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) 

@@ -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

@@ -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