Test field prefixes

README.md

@@ -1 +1,8 @@
 # json-to-haskell
+
+In goes JSON, out comes Haskell!
+
+```json
+{
+}
+```

app/Flags.hs

@@ -107,6 +107,9 @@ optionParser = do
     _includeInstances <- flag True False
                 (long "no-instances"
                  <> stringDoc [r|Omit the ToJSON and FromJSON instances.|])
+    _prefixRecordFields <- flag True False
+                (long "no-prefix-record-fields"
+                 <> stringDoc [r|Omit record field prefixes.|])
     _strictData <- flag False True
                 (long "strict"
                  <> stringDoc [r|Use strict record fields.|])

json-to-haskell.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: eef35bf2744a110c2709a6f12e18903f9d8dbee611a19fdf581156997582bc58
+-- hash: c95238f04c404a5eb4fba98349ed2ca5bb5292ae940bd464725e8f369d6bc4ea
 
 name:           json-to-haskell
 version:        0.1.0.0
@@ -52,7 +52,7 @@ library
     , vector
   default-language: Haskell2010
 
-executable json-to-haskell-exe
+executable json-to-haskell
   main-is: Main.hs
   other-modules:
       Flags

package.yaml

@@ -43,7 +43,7 @@ library:
   - -Wincomplete-patterns
 
 executables:
-  json-to-haskell-exe:
+  json-to-haskell:
     main:                Main.hs
     source-dirs:         app
     ghc-options:

src/JsonToHaskell/Internal/Options.hs

@@ -14,7 +14,7 @@ data NumberType =
     -- | Use 'Double' for all numbers
   | UseDoubles
     -- | Use 'Scientific' for all numbers
-  | UseScientificNumbers
+  | UseScientific
   deriving (Show, Eq)
 
 -- | Choose which type to use for strings
@@ -53,6 +53,7 @@ data Options = Options
   , _includeHeader :: Bool
   , _includeInstances :: Bool
   , _strictData :: Bool
+  , _prefixRecordFields :: Bool
   }
 
 
@@ -70,6 +71,7 @@ simpleOptions = Options
     , _includeHeader = True
     , _includeInstances = False
     , _strictData = False
+    , _prefixRecordFields = True
     }
 
 -- | Use more performant data types, use these for production apps.
@@ -82,8 +84,8 @@ performantOptions = Options
     , _listType = UseList
     , _includeHeader = True
     , _includeInstances = False
-    -- TODO
     , _strictData = True
+    , _prefixRecordFields = True
     }
 
 

src/JsonToHaskell/Internal/Printer.hs

@@ -19,7 +19,7 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.Map as M
 import qualified Data.Text as T
 import Text.Casing (toCamel, fromAny)
-import Data.Char (isAlpha, isAlphaNum)
+import Data.Char (isAlpha, isAlphaNum, toUpper)
 import Lens.Micro.Platform (view, (+~), (<&>))
 
 
@@ -64,6 +64,14 @@ indented m = do
 
 type Builder a = ReaderT Env (Writer T.Text) ()
 
+writeFieldName :: T.Text -> T.Text -> Builder ()
+writeFieldName recordName fieldName = do
+    addPrefix <- view (options . prefixRecordFields)
+    let fieldName' = if addPrefix 
+                        then recordName <> toRecordName fieldName
+                        else fieldName
+    tell $ toFieldName fieldName'
+
 -- | Write out the Haskell code for a record data type
 writeRecord :: StructName -> RecordFields 'Ref -> Builder ()
 writeRecord name struct = do
@@ -75,7 +83,7 @@ writeRecord name struct = do
         line $ do
             if (i == 0) then tell "{ "
                         else tell ", "
-            tell $ toFieldName k
+            writeFieldName name k
             tell " :: "
             useStrictData <- view (options . strictData)
             when useStrictData (tell "!")
@@ -101,7 +109,7 @@ writeToJSONInstance name struct = do
                                 else tell ", "
                     tell $ "\"" <> escapeQuotes k <> "\""
                     tell " .= "
-                    tell $ toFieldName k
+                    writeFieldName name k
             line . tell $ "] "
 
 -- | Write out the Haskell code for a FromJSON instance for the given record
@@ -113,7 +121,7 @@ writeFromJSONInstance name struct = do
         indented $ do
             for_ (HM.keys struct) $ \k -> do
                 line $ do
-                    tell $ toFieldName k
+                    writeFieldName name k
                     tell " <- v .: "
                     tell $ "\"" <> escapeQuotes k <> "\""
             line $ do
@@ -139,7 +147,7 @@ writeType nested struct = do
         case (pref, t) of
             (UseFloats, _) -> tell "Float"
             (UseDoubles, _) -> tell "Double"
-            (UseScientificNumbers, _) -> tell "Scientific"
+            (UseScientific, _) -> tell "Scientific"
             (UseSmartFloats, Fractional) -> tell "Float"
             (UseSmartFloats, Whole) -> tell "Int"
             (UseSmartDoubles, Fractional) -> tell "Double"
@@ -170,6 +178,9 @@ writeModel :: Options -> BM.Bimap T.Text (RecordFields 'Ref) -> T.Text
 writeModel opts (BM.toMap -> m) = execWriter . flip runReaderT (Env opts 0) $ do
     incHeader <- view (options . includeHeader)
     incInstances <- view (options . includeInstances)
+    includeScientific <- view (options . numberType) <&> (== UseScientific)
+    includeVector <- view (options . listType) <&> (== UseVector)
+    includeText <- view (options . textType) <&> (== UseText)
     when incHeader $ do
         tell . T.unlines $
             [ "{-# LANGUAGE DuplicateRecordFields #-}"
@@ -177,12 +188,12 @@ writeModel opts (BM.toMap -> m) = execWriter . flip runReaderT (Env opts 0) $ do
             , "{-# LANGUAGE OverloadedStrings #-}"
             , "module Model where"
             , ""
-            , "import Prelude (Double, Bool, Show, Eq, Ord, ($), pure)"
             , "import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), (.:), (.=), object)"
             , "import Data.Aeson.Types (prependFailure, typeMismatch)"
-            , "import Data.Text (Text)"
-            , "import Data.Vector (Vector)"
             ]
+        when includeVector . line . tell $ "import Data.Vector (Vector)"
+        when includeScientific . line . tell $ "import Data.Scientific (Scientific)"
+        when includeText . line . tell $ "import Data.Text (Text)"
         newline
     void . flip M.traverseWithKey m $ \k v -> do
         writeRecord k v

test/Spec.hs

@@ -34,10 +34,10 @@ spec = do
                `shouldRender`
                 [r|
 data Model = Model
-  { a :: Double
-  , d :: Double
-  , b :: Text
-  , c :: [Maybe Value]
+  { modelA :: Double
+  , modelD :: Double
+  , modelB :: Text
+  , modelC :: [Maybe Value]
   } deriving (Show, Eq, Ord)
                 |]
         it "should share records definitions for identical subrecords" $ do
@@ -49,13 +49,13 @@ data Model = Model
                `shouldRender`
                 [r|
 data A = A
-  { age :: Double
-  , name :: Text
+  { aAge :: Double
+  , aName :: Text
   } deriving (Show, Eq, Ord)
 
 data Model = Model
-  { a :: A
-  , b :: A
+  { modelA :: A
+  , modelB :: A
   } deriving (Show, Eq, Ord)
                 |]
         it "should pick good names for differing records which share field names" $ do
@@ -67,24 +67,24 @@ data Model = Model
                `shouldRender`
                 [r|
 data A = A
-  { field :: Field
+  { aField :: Field
   } deriving (Show, Eq, Ord)
 
 data B = B
-  { field :: Field2
+  { bField :: Field2
   } deriving (Show, Eq, Ord)
 
 data Field = Field
-  { name :: Text
+  { fieldName :: Text
   } deriving (Show, Eq, Ord)
 
 data Field2 = Field2
-  { age :: Double
+  { field2Age :: Double
   } deriving (Show, Eq, Ord)
 
 data Model = Model
-  { a :: A
-  , b :: B
+  { modelA :: A
+  , modelB :: B
   } deriving (Show, Eq, Ord)
                 |]
         it "should pick the best name if there are multiple possible names but some conflict" $ do
@@ -97,29 +97,29 @@ data Model = Model
                `shouldRender`
                 [r|
 data A = A
-  { field :: Field
+  { aField :: Field
   } deriving (Show, Eq, Ord)
 
 data B = B
-  { field :: Other
+  { bField :: Other
   } deriving (Show, Eq, Ord)
 
 data C = C
-  { other :: Other
+  { cOther :: Other
   } deriving (Show, Eq, Ord)
 
 data Field = Field
-  { name :: Text
+  { fieldName :: Text
   } deriving (Show, Eq, Ord)
 
 data Model = Model
-  { a :: A
-  , b :: B
-  , c :: C
+  { modelA :: A
+  , modelB :: B
+  , modelC :: C
   } deriving (Show, Eq, Ord)
 
 data Other = Other
-  { age :: Double
+  { otherAge :: Double
   } deriving (Show, Eq, Ord)
                 |]
 
@@ -131,10 +131,10 @@ data Other = Other
                `shouldRender`
                 [r|
 data Model = Model
-  { theNam9e :: TheNam9e
+  { modelTheNam9e :: TheNam9e
   } deriving (Show, Eq, Ord)
 
 data TheNam9e = TheNam9e
-  { subField :: Text
+  { theNam9eSubField :: Text
   } deriving (Show, Eq, Ord)
                 |]