Browse Source

Added json2eben program

Getty Ritter 7 years ago
parent
commit
6c6090ac32
3 changed files with 93 additions and 15 deletions
  1. 49 13
      Data/Eben.hs
  2. 9 2
      eben.cabal
  3. 35 0
      json2eben/Main.hs

+ 49 - 13
Data/Eben.hs

@@ -24,19 +24,56 @@ data Value
     deriving (Eq, Show, Read)
 
 decode :: ByteString -> Maybe (Value, ByteString)
-decode bs = go
-  where go = case BS.uncons bs of
-          Just (108, rs) -> decodeList
-          Just (100, rs) -> decodeDict
-          Just (105, rs) -> decodeInt
-          Just (102, rs) -> decodeFloat
+decode = go
+  where go bs = case BS.uncons bs of
+          Just (108, rs) -> decodeList [] rs
+          Just (100, rs) -> decodeDict [] rs
+          Just (105, rs) -> decodeInt rs
+          Just (102, rs) -> decodeFloat rs
           Just (i  , rs)
-            | isDigit (fromIntegral i) ->
-              let (is, rs')   = BS.break (== 58) rs
-                  len         = toNum (toDigit i) is
-                  (str, rs'') = BS.splitAt len (BS.tail rs')
-              in Just (String (BS.toStrict str), rs'')
+            | isDigit (fromIntegral i) -> do
+              (s, rs) <- decodeBS bs
+              return (String s, rs)
             | otherwise -> Nothing
+        decodeList ls bs = case BS.uncons bs of
+          Just (101, rs) -> Just (List ls, rs)
+          _ -> do
+            (x, rs) <- go bs
+            decodeList (ls ++ [x]) rs
+        decodeDict ls bs = case BS.uncons bs of
+          Just (101, rs) -> Just (Dict (M.fromList ls), rs)
+          _ -> do
+            (k, rs)  <- decodeBS bs
+            (v, rs') <- go rs
+            decodeDict ((k,v):ls) rs'
+        decodeInt bs =
+          let (is, rs) = BS.break (== 101) bs
+          in return (Integer (toNum 0 is), BS.tail rs)
+        decodeFloat bs =
+          let (fs, rs) = BS.splitAt 4 bs
+          in return (Float 0.0, BS.tail rs)
+        decodeBS bs =
+          let (is, rs')   = BS.break (== 58) bs
+              len         = toNum 0 is
+              (str, rs'') = BS.splitAt len (BS.tail rs')
+          in Just (BS.toStrict str, rs'')
+
+asDict :: Value -> Maybe (Map B.ByteString Value)
+asDict (Dict ds) = Just ds
+asDict _         = Nothing
+
+asList :: Value -> Maybe [Value]
+asList (List ls) = Just ls
+asList _         = Nothing
+
+asFloat :: Value -> Maybe Float
+asFloat (Float f)   = Just f
+asFloat (Integer i) = Just (fromIntegral i)
+asFloat _           = Nothing
+
+lookup :: B.ByteString -> Value -> Maybe Value
+lookup k (Dict ds) = M.lookup k ds
+lookup _ _         = Nothing
 
 isDigit :: Word8 -> Bool
 isDigit n = n >= 48 && n <= 57
@@ -46,10 +83,9 @@ toDigit n = fromIntegral n - 48
 
 toNum :: Int64 -> ByteString -> Int64
 toNum n (BS.uncons->Just(b, bs)) =
-  toNum (n * 10 + fromIntegral b) bs
+  toNum (n * 10 + toDigit b) bs
 toNum n _ = n
 
-
 encode :: Value -> ByteString
 encode = BL.toLazyByteString . go
   where go (List vs) =

+ 9 - 2
eben.cabal

@@ -19,6 +19,13 @@ library
   exposed-modules:     Data.Eben
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.8 && <4.9, bytestring, containers
+  build-depends:       base >=4.8 && <4.9, bytestring, containers, cereal
   -- hs-source-dirs:
-  default-language:    Haskell2010
+  default-language:    Haskell2010
+
+executable json2eben
+  hs-source-dirs: json2eben
+  main-is: Main.hs
+  default-extensions: OverloadedStrings, ScopedTypeVariables
+  build-depends: base >=4.8 && <4.9, eben, aeson, scientific, vector, text, bytestring, containers, unordered-containers
+  default-language: Haskell2010

+ 35 - 0
json2eben/Main.hs

@@ -0,0 +1,35 @@
+module Main where
+
+import qualified Data.Aeson as J
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.ByteString.Lazy.Char8 as BS8
+import qualified Data.Eben as E
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict as M
+import           Data.Scientific (floatingOrInteger)
+import qualified Data.Vector as V
+import           Data.Text.Encoding (encodeUtf8)
+
+convert :: J.Value -> Either String E.Value
+convert (J.Array as)  =
+  (E.List . V.toList) `fmap` traverse convert as
+convert (J.Object os) =
+  (E.Dict . M.fromList) `fmap` sequence
+    [ sequence (encodeUtf8 k, convert v)
+    | (k, v) <- HM.toList os
+    ]
+convert (J.String ts) = pure (E.String (encodeUtf8 ts))
+convert (J.Number n)  = case floatingOrInteger n of
+  Left f  -> pure (E.Float f)
+  Right i -> pure (E.Integer i)
+convert (J.Bool _)    = Left "No Eben repr for bool"
+convert J.Null        = Left "No Eben repr for null"
+
+main :: IO ()
+main = do
+  cs <- BS.getContents
+  case J.decode cs of
+    Nothing -> putStrLn "Not valid JSON"
+    Just vs -> case convert vs of
+      Left err -> putStrLn err
+      Right eb -> BS8.putStrLn (E.encode eb)