gdritter repos eben / 6c6090a
Added json2eben program Getty Ritter 7 years ago
3 changed file(s) with 93 addition(s) and 15 deletion(s). Collapse all Expand all
+49
-13
Data/Eben.hs less more
2424 deriving (Eq, Show, Read)
2525
2626 decode :: ByteString -> Maybe (Value, ByteString)
27 decode bs = go
28 where go = case BS.uncons bs of
29 Just (108, rs) -> decodeList
30 Just (100, rs) -> decodeDict
31 Just (105, rs) -> decodeInt
32 Just (102, rs) -> decodeFloat
27 decode = go
28 where go bs = case BS.uncons bs of
29 Just (108, rs) -> decodeList [] rs
30 Just (100, rs) -> decodeDict [] rs
31 Just (105, rs) -> decodeInt rs
32 Just (102, rs) -> decodeFloat rs
3333 Just (i , rs)
34 | isDigit (fromIntegral i) ->
35 let (is, rs') = BS.break (== 58) rs
36 len = toNum (toDigit i) is
37 (str, rs'') = BS.splitAt len (BS.tail rs')
38 in Just (String (BS.toStrict str), rs'')
34 | isDigit (fromIntegral i) -> do
35 (s, rs) <- decodeBS bs
36 return (String s, rs)
3937 | otherwise -> Nothing
38 decodeList ls bs = case BS.uncons bs of
39 Just (101, rs) -> Just (List ls, rs)
40 _ -> do
41 (x, rs) <- go bs
42 decodeList (ls ++ [x]) rs
43 decodeDict ls bs = case BS.uncons bs of
44 Just (101, rs) -> Just (Dict (M.fromList ls), rs)
45 _ -> do
46 (k, rs) <- decodeBS bs
47 (v, rs') <- go rs
48 decodeDict ((k,v):ls) rs'
49 decodeInt bs =
50 let (is, rs) = BS.break (== 101) bs
51 in return (Integer (toNum 0 is), BS.tail rs)
52 decodeFloat bs =
53 let (fs, rs) = BS.splitAt 4 bs
54 in return (Float 0.0, BS.tail rs)
55 decodeBS bs =
56 let (is, rs') = BS.break (== 58) bs
57 len = toNum 0 is
58 (str, rs'') = BS.splitAt len (BS.tail rs')
59 in Just (BS.toStrict str, rs'')
60
61 asDict :: Value -> Maybe (Map B.ByteString Value)
62 asDict (Dict ds) = Just ds
63 asDict _ = Nothing
64
65 asList :: Value -> Maybe [Value]
66 asList (List ls) = Just ls
67 asList _ = Nothing
68
69 asFloat :: Value -> Maybe Float
70 asFloat (Float f) = Just f
71 asFloat (Integer i) = Just (fromIntegral i)
72 asFloat _ = Nothing
73
74 lookup :: B.ByteString -> Value -> Maybe Value
75 lookup k (Dict ds) = M.lookup k ds
76 lookup _ _ = Nothing
4077
4178 isDigit :: Word8 -> Bool
4279 isDigit n = n >= 48 && n <= 57
4683
4784 toNum :: Int64 -> ByteString -> Int64
4885 toNum n (BS.uncons->Just(b, bs)) =
49 toNum (n * 10 + fromIntegral b) bs
86 toNum (n * 10 + toDigit b) bs
5087 toNum n _ = n
51
5288
5389 encode :: Value -> ByteString
5490 encode = BL.toLazyByteString . go
+9
-2
eben.cabal less more
1919 exposed-modules: Data.Eben
2020 -- other-modules:
2121 -- other-extensions:
22 build-depends: base >=4.8 && <4.9, bytestring, containers
22 build-depends: base >=4.8 && <4.9, bytestring, containers, cereal
2323 -- hs-source-dirs:
24 default-language: Haskell2010⏎
24 default-language: Haskell2010
25
26 executable json2eben
27 hs-source-dirs: json2eben
28 main-is: Main.hs
29 default-extensions: OverloadedStrings, ScopedTypeVariables
30 build-depends: base >=4.8 && <4.9, eben, aeson, scientific, vector, text, bytestring, containers, unordered-containers
31 default-language: Haskell2010
+35
-0
json2eben/Main.hs less more
1 module Main where
2
3 import qualified Data.Aeson as J
4 import qualified Data.ByteString.Lazy as BS
5 import qualified Data.ByteString.Lazy.Char8 as BS8
6 import qualified Data.Eben as E
7 import qualified Data.HashMap.Strict as HM
8 import qualified Data.Map.Strict as M
9 import Data.Scientific (floatingOrInteger)
10 import qualified Data.Vector as V
11 import Data.Text.Encoding (encodeUtf8)
12
13 convert :: J.Value -> Either String E.Value
14 convert (J.Array as) =
15 (E.List . V.toList) `fmap` traverse convert as
16 convert (J.Object os) =
17 (E.Dict . M.fromList) `fmap` sequence
18 [ sequence (encodeUtf8 k, convert v)
19 | (k, v) <- HM.toList os
20 ]
21 convert (J.String ts) = pure (E.String (encodeUtf8 ts))
22 convert (J.Number n) = case floatingOrInteger n of
23 Left f -> pure (E.Float f)
24 Right i -> pure (E.Integer i)
25 convert (J.Bool _) = Left "No Eben repr for bool"
26 convert J.Null = Left "No Eben repr for null"
27
28 main :: IO ()
29 main = do
30 cs <- BS.getContents
31 case J.decode cs of
32 Nothing -> putStrLn "Not valid JSON"
33 Just vs -> case convert vs of
34 Left err -> putStrLn err
35 Right eb -> BS8.putStrLn (E.encode eb)