gdritter repos adnot / 288763d
Added basic FromAdnot class as well Getty Ritter 8 years ago
2 changed file(s) with 184 addition(s) and 8 deletion(s). Collapse all Expand all
+182
-8
Data/Adnot/Class.hs less more
77 {-# LANGUAGE ScopedTypeVariables #-}
88 {-# LANGUAGE DefaultSignatures #-}
99 {-# LANGUAGE DataKinds #-}
10 {-# LANGUAGE GADTs #-}
1011
1112 module Data.Adnot.Class where
1213
14 import Control.Monad ((>=>))
15 import Data.Adnot.Parse
1316 import Data.Adnot.Type
1417 import Data.Adnot.Emit
1518 import Data.Int
1619 import Data.Word
20 import qualified Data.ByteString as BS
1721 import qualified Data.ByteString.Lazy as BSL
1822 import qualified Data.Foldable as F
1923 import qualified Data.List.NonEmpty as NE
97101 default toAdnot :: (Generic a, GenToAdnot (Rep a)) => a -> Value
98102 toAdnot = genericToAdnot
99103
100 -- * Integral types
104 -- Integral types
101105 instance ToAdnot Int where
102106 toAdnot n = Integer (fromIntegral n)
103107
131135 instance ToAdnot Word64 where
132136 toAdnot n = Integer (fromIntegral n)
133137
134 -- * Rational/Floating types
138 -- Rational/Floating types
135139 instance ToAdnot Double where
136140 toAdnot d = Double d
137141
138142 instance ToAdnot Float where
139143 toAdnot d = Double (fromRational (toRational d))
140144
141 -- * String types
145 -- String types
142146 instance {-# INCOHERENT #-} ToAdnot String where
143147 toAdnot s = String (T.pack s)
144148
151155 instance ToAdnot Char where
152156 toAdnot c = String (T.singleton c)
153157
154 -- * List types
158 -- List types
155159 instance ToAdnot a => ToAdnot [a] where
156160 toAdnot ls = List (fmap toAdnot (V.fromList ls))
157161
164168 instance ToAdnot a => ToAdnot (NE.NonEmpty a) where
165169 toAdnot ls = List (V.fromList (F.toList (fmap toAdnot ls)))
166170
167 -- * Mapping types
171 -- Mapping types
168172 instance ToAdnot a => ToAdnot (MS.Map T.Text a) where
169173 toAdnot ls = Product (fmap toAdnot ls)
170174
171 -- * Tuples
175 -- Tuples
172176 instance ToAdnot () where
173177 toAdnot () = List []
174178
182186 => ToAdnot (a, b, c, d) where
183187 toAdnot (a, b, c, d) = List [toAdnot a, toAdnot b, toAdnot c, toAdnot d]
184188
185 -- Some common Haskell algebraic data types
189 -- Common Haskell algebraic data types
186190 instance ToAdnot a => ToAdnot (Maybe a) where
187191 toAdnot Nothing = Sum "Nothing" []
188192 toAdnot (Just x) = Sum "Just" [toAdnot x]
195199 toAdnot True = Symbol "True"
196200 toAdnot False = Symbol "False"
197201
198 -- * Parsing
202 -- Parsing
203
204 decode :: FromAdnot a => BS.ByteString -> Either String a
205 decode = decodeValue >=> parseAdnot
199206
200207 type ParseError = String
201208 type Parser a = Either ParseError a
205212 Sum t as -> k t as
206213 _ -> Left ("Expected sum in " ++ n)
207214
215 withProduct :: String -> (Product -> Parser a) -> Value -> Parser a
216 withProduct n k val = case val of
217 Product ps -> k ps
218 _ -> Left ("Expected product in " ++ n)
219
220 withList :: String -> (Array -> Parser a) -> Value -> Parser a
221 withList n k val = case val of
222 List ls -> k ls
223 _ -> Left ("Expected list in " ++ n)
224
225 withInteger :: String -> (Integer -> Parser a) -> Value -> Parser a
226 withInteger n k val = case val of
227 Integer i -> k i
228 _ -> Left ("Expected integer in " ++ n)
229
230 withDouble :: String -> (Double -> Parser a) -> Value -> Parser a
231 withDouble n k val = case val of
232 Double d -> k d
233 _ -> Left ("Expected double in " ++ n)
234
235 withSymbol :: String -> (T.Text -> Parser a) -> Value -> Parser a
236 withSymbol n k val = case val of
237 Symbol s -> k s
238 _ -> Left ("Expected symbol in " ++ n)
239
240 withString :: String -> (T.Text -> Parser a) -> Value -> Parser a
241 withString n k val = case val of
242 String s -> k s
243 _ -> Left ("Expected string in " ++ n)
244
208245 class FromAdnot a where
209246 parseAdnot :: Value -> Parser a
247
248 instance FromAdnot Value where
249 parseAdnot = return
250
251 -- Integer Types
252 instance FromAdnot Int where
253 parseAdnot = withInteger "Int" (return . fromIntegral)
254
255 instance FromAdnot Integer where
256 parseAdnot = withInteger "Int" return
257
258 instance FromAdnot Int8 where
259 parseAdnot = withInteger "Int8" (return . fromIntegral)
260
261 instance FromAdnot Int16 where
262 parseAdnot = withInteger "Int16" (return . fromIntegral)
263
264 instance FromAdnot Int32 where
265 parseAdnot = withInteger "Int32" (return . fromIntegral)
266
267 instance FromAdnot Int64 where
268 parseAdnot = withInteger "Int64" (return . fromIntegral)
269
270 instance FromAdnot Word where
271 parseAdnot = withInteger "Word" (return . fromIntegral)
272
273 instance FromAdnot Word8 where
274 parseAdnot = withInteger "Word8" (return . fromIntegral)
275
276 instance FromAdnot Word16 where
277 parseAdnot = withInteger "Word16" (return . fromIntegral)
278
279 instance FromAdnot Word32 where
280 parseAdnot = withInteger "Word32" (return . fromIntegral)
281
282 instance FromAdnot Word64 where
283 parseAdnot = withInteger "Word64" (return . fromIntegral)
284
285 -- Rational/Floating types
286
287 instance FromAdnot Double where
288 parseAdnot = withDouble "Double" return
289
290 instance FromAdnot Float where
291 parseAdnot =
292 withDouble "Float" (return . fromRational . toRational)
293
294 -- String types
295
296 instance {-# INCOHERENT #-} FromAdnot String where
297 parseAdnot = withString "String" (return . T.unpack)
298
299 instance FromAdnot T.Text where
300 parseAdnot = withString "Text" return
301
302 instance FromAdnot TL.Text where
303 parseAdnot = withString "Text" (return . TL.fromStrict)
304
305 instance FromAdnot Char where
306 parseAdnot = withString "Char" $ \s -> case T.uncons s of
307 Just (c, "") -> return c
308 _ -> Left "Expected a single-element string"
309
310
311 -- List types
312 instance FromAdnot a => FromAdnot [a] where
313 parseAdnot = withList "List" $ \ls ->
314 F.toList <$> mapM parseAdnot ls
315
316 instance FromAdnot a => FromAdnot (V.Vector a) where
317 parseAdnot = withList "Vector" $ \ls ->
318 mapM parseAdnot ls
319
320 instance FromAdnot a => FromAdnot (Seq.Seq a) where
321 parseAdnot = withList "Seq" $ \ls ->
322 Seq.fromList . F.toList <$> mapM parseAdnot ls
323
324 instance FromAdnot a => FromAdnot (NE.NonEmpty a) where
325 parseAdnot = withList "NonEmpty" $ \ls -> do
326 lst <- mapM parseAdnot ls
327 case F.toList lst of
328 [] -> Left "Expected non-empty sequence"
329 (x:xs) -> Right (x NE.:| xs)
330
331 -- Mapping types
332 instance FromAdnot a => FromAdnot (MS.Map T.Text a) where
333 parseAdnot = withProduct "Map" $ \ms -> do
334 lst <- mapM parseAdnot ms
335 return (MS.fromList (F.toList lst))
336
337 -- Tuples
338 instance FromAdnot () where
339 parseAdnot = withList "()" $ \ls ->
340 case ls of
341 [] -> return ()
342 _ -> Left "Expected empty list"
343
344 instance (FromAdnot a, FromAdnot b) => FromAdnot (a, b) where
345 parseAdnot = withList "(a, b)" $ \ls ->
346 case ls of
347 [a, b] -> (,) <$> parseAdnot a <*> parseAdnot b
348 _ -> Left "Expected two-element list"
349
350
351 instance (FromAdnot a, FromAdnot b, FromAdnot c) => FromAdnot (a, b, c) where
352 parseAdnot = withList "(a, b, c)" $ \ls ->
353 case ls of
354 [a, b, c] -> (,,) <$> parseAdnot a <*> parseAdnot b <*> parseAdnot c
355 _ -> Left "Expected three-element list"
356
357
358 instance (FromAdnot a, FromAdnot b, FromAdnot c, FromAdnot d)
359 => FromAdnot (a, b, c, d) where
360 parseAdnot = withList "(a, b, c, d)" $ \ls ->
361 case ls of
362 [a, b, c, d] -> (,,,) <$> parseAdnot a <*> parseAdnot b
363 <*> parseAdnot c <*> parseAdnot d
364 _ -> Left "Expected four-element list"
365
366 -- Common Haskell algebraic data types
367 instance FromAdnot a => FromAdnot (Maybe a) where
368 parseAdnot = withSum "Maybe" go
369 where go "Nothing" [] = return Nothing
370 go "Just" [x] = Just <$> parseAdnot x
371 go _ _ = Left "Invalid Maybe"
372
373 instance (FromAdnot a, FromAdnot b) => FromAdnot (Either a b) where
374 parseAdnot = withSum "Either" go
375 where go "Left" [x] = Left <$> parseAdnot x
376 go "Right" [x] = Right <$> parseAdnot x
377 go _ _ = Left "Invalid Either"
378
379 instance FromAdnot Bool where
380 parseAdnot = withSymbol "Bool" go
381 where go "True" = return True
382 go "False" = return False
383 go _ = Left "Invalid Bool"
+2
-0
Data/Adnot.hs less more
33 , Product
44 , decodeValue
55 , encodeValue
6 , module Data.Adnot.Class
67 ) where
78
89 import Data.Adnot.Emit
910 import Data.Adnot.Parse
1011 import Data.Adnot.Type
12 import Data.Adnot.Class