Skip to content

Commit

Permalink
add parsing of integer type for json, for number and int date on l4
Browse files Browse the repository at this point in the history
  • Loading branch information
Meowyam committed Oct 10, 2023
1 parent cf7c399 commit 5b5d7ac
Showing 1 changed file with 11 additions and 5 deletions.
16 changes: 11 additions & 5 deletions lib/haskell/natural4/src/LS/XPile/ExportTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ data FieldType =
| FTRef TypeName
| FTList FieldType
| FTDate
| FTInteger
deriving (Eq, Ord, Show, Read)

data Field = Field
Expand All @@ -78,7 +79,7 @@ data Field = Field
-- non-json-schema-specific metadata will be moved to another module

-- can think about moving to using references to these records instead of a sum of records with different fieldnames
-- data TypeRec = MkTypeRecord
-- data TypeRec = MkTypeRecord
-- { typeName :: TypeName
-- , fields :: [Field]
-- }
Expand Down Expand Up @@ -124,6 +125,7 @@ getEnums = map mtexpr2text . SFL4.extractMTExprs

textToFieldType :: T.Text -> FieldType
textToFieldType tn = case tn of
"Integer" -> FTInteger
"Boolean" -> FTBoolean
"Number" -> FTNumber
"String" -> FTString
Expand Down Expand Up @@ -231,14 +233,15 @@ class ShowTypesHaskell x where
instance ShowTypesHaskell FieldType where
showTypesHaskell FTBoolean = "Bool"
showTypesHaskell FTNumber = "Int"
showTypesHaskell FTInteger = "Int"
showTypesHaskell FTString = "String"
showTypesHaskell FTDate = "String"
showTypesHaskell (FTRef n) = pretty $ hTypeName n
showTypesHaskell (FTList t) = brackets $ showTypesHaskell t

instance ShowTypesHaskell Field where
showTypesHaskell (Field fn ft) =
-- trace ("Field: " ++ (show f) ) $
showTypesHaskell (Field fn ft) =
-- trace ("Field: " ++ (show f) ) $
pretty (hFieldName fn) <> " :: " <> showTypesHaskell ft

instance ShowTypesHaskell JSchemaExp where
Expand Down Expand Up @@ -305,6 +308,7 @@ class ShowTypesProlog x where
instance ShowTypesProlog FieldType where
showTypesProlog FTBoolean = "boolean"
showTypesProlog FTNumber = "number"
showTypesProlog FTInteger = "integer"
showTypesProlog FTString = "string"
showTypesProlog FTDate = "string"
showTypesProlog (FTRef n) = "ref" <> parens (pretty n)
Expand Down Expand Up @@ -385,6 +389,8 @@ showRef n = [__di| "$ref": "#{defsLocation n}"|]
-- but arrays of length 1.
-- List types can only have nesting level 1 (a limitation inherited from Natural4)
instance ShowTypesJson FieldType where
showTypesJson FTInteger =
jsonType "integer"
showTypesJson FTBoolean =
jsonType "boolean"
showTypesJson FTNumber =
Expand Down Expand Up @@ -422,7 +428,7 @@ instance ShowTypesJson JSchemaExp where
showTypesJson (ExpTypeRecord tn fds) =
pprintJsonObj tn fds requiredFds
where requiredFds = "," <> nest 4 (showRequireds fds)

pprintJsonObj :: (Pretty a, ShowTypesJson b) => a -> [b] -> Doc ann -> Doc ann
pprintJsonObj key values final =
dquotes (pretty key) <> ": " <>
Expand Down Expand Up @@ -454,7 +460,7 @@ rulesToJsonSchema rs =
[] -> show $ braces emptyDoc
(rt : _rts) ->
-- trace ("ets: " ++ show ets) $
show [__di|
show [__di|
{#{jsonPreamble (typeName rt)},
"#{pretty defsLocationName}":
{#{vsep (punctuate comma subJsonObjs)}}
Expand Down

0 comments on commit 5b5d7ac

Please sign in to comment.