{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.Eben where
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BL
import Data.Int (Int64)
import Data.List (sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map as M
import Data.Monoid ((<>))
import Data.Word (Word8)
data Value
= List [Value]
| Dict (Map B.ByteString Value)
| Integer Int64
| Float Float
| String B.ByteString
deriving (Eq, Show, Read)
decode :: ByteString -> Maybe (Value, ByteString)
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) -> 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'')
class FromEben t where
fromEben :: Value -> Maybe t
instance FromEben Float where
fromEben (Float f) = Just f
fromEben (Integer i) = Just (fromIntegral i)
fromEben _ = Nothing
instance FromEben Int where
fromEben (Integer i) = Just (fromIntegral i)
fromEben _ = Nothing
instance FromEben a => FromEben [a] where
fromEben (List ls) = mapM fromEben ls
fromEben _ = Nothing
instance (FromEben a, FromEben b) => FromEben (a, b) where
fromEben (List [x,y]) = (,) <$> fromEben x <*> fromEben y
fromEben _ = Nothing
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
toDigit :: Word8 -> Int64
toDigit n = fromIntegral n - 48
toNum :: Int64 -> ByteString -> Int64
toNum n (BS.uncons->Just(b, bs)) =
toNum (n * 10 + toDigit b) bs
toNum n _ = n
class ToEben t where
toEben :: t -> Value
instance ToEben a => ToEben [a] where
toEben = List . map toEben
instance ToEben Float where
toEben = Float
instance ToEben Int where
toEben = Integer . fromIntegral
instance ToEben Integer where
toEben = Integer . fromIntegral
instance (ToEben l, ToEben r) => ToEben (l, r) where
toEben (x, y) = List [ toEben x, toEben y ]
dict :: [(B.ByteString, Value)] -> Value
dict = Dict . M.fromList
encode :: Value -> ByteString
encode = BL.toLazyByteString . go
where go (List vs) =
BL.char7 'l' <> foldMap go vs <> BL.char7 'e'
go (Dict vs) =
BL.char7 'd'
<> mconcat [ str k <> go v | (k, v) <- sortOn fst (M.toList vs) ]
<> BL.char7 'e'
go (Integer i) =
BL.char7 'i' <> BL.string8 (show i) <> BL.char7 'e'
go (Float f) =
BL.char7 'f' <> BL.floatLE f <> BL.char7 'e'
go (String bs) = str bs
str bs =
BL.intDec (B.length bs)
<> BL.char7 ':'
<> BL.byteString bs