on master help sign in
wip
commit083997b307aecf7268e8d33e1eb742015bea4374 authoriko <ilyakooo0@gmail.com> dateFri 29 Jul 2022, 20:21 (4 years ago) parentdda09b2
1 file changed+45−1
src/Main.hs+45−1
src/Main.hs+45−1
@@ -31,6 +31,7 @@ data Datatype
3131 | FloatType
3232 | StringType
3333 | List Datatype
34+ | MaybeType Datatype
3435 deriving stock (Show)
3536
3637newtype SumType = SumType (Map Text (Maybe Datatype))
@@ -47,6 +48,7 @@ parseSumType = fmap (SumType . fold) . traverse parseConstructor . V.toList
4748instance FromJSON Datatype where
4849 parseJSON (Array a) = SumDatatype <$> parseSumType a
4950 parseJSON (Object o) | [("List", x)] <- HM.toList o = List <$> parseJSON x
51+ parseJSON (Object o) | [("Maybe", x)] <- HM.toList o = MaybeType <$> parseJSON x
5052 parseJSON (Object o) = ProductType <$> traverse parseJSON (M.fromList $ HM.toList o)
5153 parseJSON (String "Bool") = pure BoolType
5254 parseJSON (String "Int") = pure IntType
@@ -86,6 +88,20 @@ elmType name (List inner) = do
8688 }
8789 ]
8890 pure $ ETyCon $ ETCon $ toString name <> "_List"
91+elmType name (MaybeType inner) = do
92+ inner' <- elmType name inner
93+ tell
94+ [ ETypePrimAlias
95+ EPrimAlias
96+ { epa_name =
97+ ETypeName
98+ { et_name = toString name <> "_Maybe",
99+ et_args = []
100+ },
101+ epa_type = ETyApp (ETyCon (ETCon "Maybe")) inner'
102+ }
103+ ]
104+ pure $ ETyCon $ ETCon $ toString name <> "_Maybe"
89105elmType name (ProductType fields) = do
90106 fields' <- traverse (\(k, v) -> (toString k,) <$> elmType (name <> "_" <> k) v) $ M.toList fields
91107 tell
@@ -121,7 +137,7 @@ elmType name (SumDatatype (SumType sums)) = do
121137 _stcFields = Anonymous $ maybeToList value
122138 },
123139 es_omit_null = False,
124− es_unary_strings = False,
140+ es_unary_strings = True,
125141 es_type =
126142 SumEncoding'
127143 TaggedObject
@@ -165,6 +181,34 @@ psType name (List inner) = do
165181 allInstances
166182 ]
167183 pure ti
184+psType name (MaybeType inner) = do
185+ inner' <- psType name inner
186+ let ti =
187+ TypeInfo
188+ { _typePackage = "bridge",
189+ _typeModule = "Bridge",
190+ _typeName = name <> "_Maybe",
191+ _typeParameters = []
192+ }
193+ tell
194+ [ PS.SumType
195+ ti
196+ [ DataConstructor
197+ { _sigConstructor = name <> "_Maybe",
198+ _sigValues =
199+ Left
200+ [ TypeInfo
201+ { _typePackage = "maybe",
202+ _typeModule = "Data.Maybe",
203+ _typeName = "Maybe",
204+ _typeParameters = [inner']
205+ }
206+ ]
207+ }
208+ ]
209+ allInstances
210+ ]
211+ pure ti
168212psType name (SumDatatype (SumType sums)) = do
169213 sums' <- traverse (\(k, v) -> (k,) <$> traverse (psType (name <> "_" <> k)) v) $ M.toList sums
170214 let ti =