module TNET
(
tnetParser
, TNET(..)
, TValue
, decode
, encode
, dict
, (.=)
, (.:)
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.UTF8 as U
import Data.Attoparsec as P
import Data.Attoparsec.Char8 (char8, endOfLine)
import qualified Data.Attoparsec.Char8 as P8
import Control.Applicative
import Data.Word (Word8)
import Data.Char
import Control.Arrow (second)
data TValue = TBytes ByteString
| TString String
| TInteger Integer
| TFloat Double
| TBool Bool
| TNull
| TDict [(String, TValue)]
| TList [TValue]
deriving (Eq, Show)
dict :: [(String, TValue)] -> TValue
dict = TDict
(.=) :: (TNET a) => String -> a -> (String, TValue)
key .= val = (key, toTNET val)
(.:) :: TNET a => TValue -> String -> Maybe a
(TDict xs) .: key = let lkup = lookup key xs in
case lkup of
Nothing -> fromTNET TNull
Just v -> fromTNET v
_ .: _ = Nothing
class TNET a where
toTNET :: a -> TValue
fromTNET :: TValue -> Maybe a
instance TNET () where
toTNET = const TNull
fromTNET TNull = Just ()
fromTNET _ = Nothing
instance TNET TValue where
toTNET = id
fromTNET = Just
instance TNET Integer where
toTNET = TInteger
fromTNET (TInteger n) = Just n
fromTNET _ = Nothing
instance TNET Double where
toTNET = TFloat
fromTNET (TFloat n) = Just n
fromTNET _ = Nothing
instance TNET Bool where
toTNET = TBool
fromTNET (TBool b) = Just b
fromTNET _ = Nothing
instance TNET a => TNET [(String, a)] where
toTNET = TDict . map (second toTNET)
fromTNET (TDict d) = mapM (f . second fromTNET) d
where f (s, Just x) = Just (s, x)
f _ = Nothing
fromTNET _ = Nothing
instance TNET String where
toTNET = TString
fromTNET (TString s) = Just s
fromTNET _ = Nothing
instance TNET Char where
toTNET = TString . (:[])
fromTNET (TString [c]) = Just c
fromTNET _ = Nothing
instance TNET ByteString where
toTNET = TBytes
fromTNET (TBytes b) = Just b
fromTNET _ = Nothing
instance TNET a => TNET (Maybe a) where
toTNET = maybe TNull toTNET
fromTNET TNull = Just Nothing
fromTNET x = case fromTNET x of
Just val -> Just $ Just val
Nothing -> Nothing
instance TNET a => TNET [a] where
toTNET = TList . map toTNET
fromTNET (TList xs) = mapM fromTNET xs
fromTNET _ = Nothing
dataFromTValue :: TValue -> ByteString
dataFromTValue (TBytes bs) = bs
dataFromTValue (TString s) = U.fromString s
dataFromTValue (TBool True) = "true"
dataFromTValue (TBool False) = "false"
dataFromTValue TNull = ""
dataFromTValue (TInteger n) = (B8.pack . show) n
dataFromTValue (TFloat n) = (B8.pack . show) n
dataFromTValue (TList l) = B8.concat $ map dumpTNET l
dataFromTValue (TDict m) = B8.concat $ map dumpPair m
typeFromTValue :: TValue -> ByteString
typeFromTValue (TBytes _) = ","
typeFromTValue (TString _) = "$"
typeFromTValue (TBool _) = "!"
typeFromTValue TNull = "~"
typeFromTValue (TInteger _) = "#"
typeFromTValue (TFloat _) = "^"
typeFromTValue (TList _) = "]"
typeFromTValue (TDict _) = "}"
dumpPair :: (String, TValue) -> ByteString
dumpPair (key, value) =
dumpTNET (TString key) `B8.append` dumpTNET value
dumpTNET :: TValue -> ByteString
dumpTNET tval = let t_data = dataFromTValue tval
t_size = B8.pack . show $ B8.length t_data
t_type = typeFromTValue tval
in B8.concat [t_size, ":", t_data, t_type]
encode :: TNET a => a -> ByteString
encode = dumpTNET . toTNET
decode :: TNET a => ByteString -> Maybe a
decode s = case parse tnetParser s of
Done _ v -> fromTNET v
_ -> Nothing
tnetParser :: Parser TValue
tnetParser = do
size <- P8.decimal <* char8 ':'
t_data <- P.take size
t_type <- P8.satisfy $ P8.inClass ",$#^!~}]?"
case t_type of
',' -> return $ TBytes t_data
'$' -> return $ TString $ U.toString t_data
'~' -> if size == 0 then return TNull
else empty
'!' -> case parseOnly p_bool t_data of
Left err -> fail "failed to parse bool"
Right b -> return b
'?' -> case parseOnly p_smallbool t_data of
Left err -> fail "failed to parse bool"
Right b -> return b
'#' -> case parseOnly (P8.signed P8.decimal) t_data of
Left err -> fail "failed to parse integer"
Right n -> return $ TInteger n
'^' -> case parseOnly (P8.signed P8.double) t_data of
Left err -> fail "failed to parse float"
Right n -> return $ TFloat n
'}' -> case parseOnly (many p_pair) t_data of
Left err -> fail "failed to parse dict"
Right m -> return $ TDict m
']' -> case parseOnly (many tnetParser) t_data of
Left err -> fail "failed to parse list"
Right m -> return $ TList m
_ -> empty
p_bool :: Parser TValue
p_bool = (return (TBool True) <* P8.string "true")
<|> return (TBool False)
p_smallbool :: Parser TValue
p_smallbool = (return (TBool True) <* P8.string "t")
<|> return (TBool False)
p_pair :: Parser (String, TValue)
p_pair = do
key <- tnetParser
value <- tnetParser
case key of
TString s -> return (s, value)
TBytes s -> return (U.toString s, value)
_ -> fail "key must be string"