-- 
-- (c) Susumu Katayama
--
module MagicHaskeller.ShortString where
import Data.ByteString.Char8      as C -- This seems quicker, except that C.cons requires O(n).
import Data.ByteString.Lazy.Char8 as LC
import Data.Char
import MagicHaskeller.CoreLang
import MagicHaskeller.Types
import Data.Int
import Data.Word

-- LC.cons' だと多分ダメ

showBriefly :: ShortString a => a -> LC.ByteString
showBriefly :: a -> ByteString
showBriefly = (a -> ByteString -> ByteString) -> ByteString -> a -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly ByteString
LC.empty
readBriefly :: ShortString a => C.ByteString -> Maybe a
readBriefly :: ByteString -> Maybe a
readBriefly = ((a, ByteString) -> a) -> Maybe (a, ByteString) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ByteString) -> a
forall a b. (a, b) -> a
fst (Maybe (a, ByteString) -> Maybe a)
-> (ByteString -> Maybe (a, ByteString)) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (a, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly

class ShortString a where
    showsBriefly :: a -> LC.ByteString -> LC.ByteString
    readsBriefly :: C.ByteString -> Maybe (a,C.ByteString)  --  ReadS a -- Maybe の方が速い? てゆーか，parse errorの割合はすごく少ないはずなのでerrorとしてcatchした方が速いはず．と思ったけど，lazyなデータなので正しくcatchできないか．

instance ShortString a => ShortString [a] where
    showsBriefly :: [a] -> ByteString -> ByteString
showsBriefly []     = Char -> ByteString -> ByteString
LC.cons Char
']'
    showsBriefly (a
x:[a]
xs) = a -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly a
x (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly [a]
xs
    readsBriefly :: ByteString -> Maybe ([a], ByteString)
readsBriefly ByteString
cs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
cs of Maybe (Char, ByteString)
Nothing       -> String -> Maybe ([a], ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
                                          Just (Char
']',ByteString
ds) -> ([a], ByteString) -> Maybe ([a], ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],ByteString
ds)
                                          Maybe (Char, ByteString)
_             -> do (a
x, ByteString
ds) <- ByteString -> Maybe (a, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
cs
                                                              ([a]
xs,ByteString
es) <- ByteString -> Maybe ([a], ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                                                              ([a], ByteString) -> Maybe ([a], ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, ByteString
es)
instance ShortString Bool where
    showsBriefly :: Bool -> ByteString -> ByteString
showsBriefly Bool
True   = Char -> ByteString -> ByteString
LC.cons Char
'T'
    showsBriefly Bool
False  = Char -> ByteString -> ByteString
LC.cons Char
'F'
instance ShortString CoreExpr where
    showsBriefly :: CoreExpr -> ByteString -> ByteString
showsBriefly (Lambda CoreExpr
ce)   = (Char -> ByteString -> ByteString
LC.cons Char
'\\') (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly CoreExpr
ce
    showsBriefly (X Int8
i)         = (Char -> ByteString -> ByteString
LC.cons Char
'X')  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Int8
i
    showsBriefly (Primitive Var
i) = (Char -> ByteString -> ByteString
LC.cons Char
'p')  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Var
i
    showsBriefly (PrimCon   Var
i) = (Char -> ByteString -> ByteString
LC.cons Char
'P')  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Var
i
    showsBriefly (Context Dictionary
_) = Char -> ByteString -> ByteString
LC.cons Char
'C'
    showsBriefly (CoreExpr
c :$ CoreExpr
e)      = (Char -> ByteString -> ByteString
LC.cons Char
'$')  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly CoreExpr
c (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly CoreExpr
e
    readsBriefly :: ByteString -> Maybe (CoreExpr, ByteString)
readsBriefly ByteString
cs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
cs of -- Int(Nat)と1文字め一緒に1バイトにできないか?あと，lambdaは続くのでまとめられそう．
                                          Just (Char
'\\',ByteString
xs) -> do (CoreExpr
ce,ByteString
ys) <- ByteString -> Maybe (CoreExpr, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
xs
                                                               (CoreExpr, ByteString) -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> CoreExpr
Lambda CoreExpr
ce, ByteString
ys)
                                          Just (Char
'X', ByteString
xs) -> do (Int8
i, ByteString
ys) <- ByteString -> Maybe (Int8, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
xs
                                                               (CoreExpr, ByteString) -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> CoreExpr
X Int8
i, ByteString
ys)
                                          Just (Char
'p', ByteString
xs) -> do (Var
i, ByteString
ys) <- ByteString -> Maybe (Var, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
xs
                                                               (CoreExpr, ByteString) -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> CoreExpr
Primitive Var
i, ByteString
ys)
                                          Just (Char
'P', ByteString
xs) -> do (Var
i, ByteString
ys) <- ByteString -> Maybe (Var, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
xs
                                                               (CoreExpr, ByteString) -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> CoreExpr
PrimCon   Var
i, ByteString
ys)
                                          Just (Char
'$', ByteString
xs) -> do (CoreExpr
c, ByteString
ys) <- ByteString -> Maybe (CoreExpr, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
xs
                                                               (CoreExpr
e, ByteString
zs) <- ByteString -> Maybe (CoreExpr, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ys
                                                               (CoreExpr, ByteString) -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr
c CoreExpr -> CoreExpr -> CoreExpr
:$ CoreExpr
e, ByteString
zs)
                                          Just (Char
'C', ByteString
xs) -> String -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"readsBriefly for classes has not been implemented. (BTW, they should be reconstructed in the implementation.)"
                                          Maybe (Char, ByteString)
_              -> String -> Maybe (CoreExpr, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
-- Only small ints are used, if I remember correctly.
instance ShortString Int where
    showsBriefly :: Int -> ByteString -> ByteString
showsBriefly Int
i = Char -> ByteString -> ByteString
LC.cons (Int -> Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
128)) -- other safer options are Numeric.showHex and Numeric.showIntAtBase
    readsBriefly :: ByteString -> Maybe (Int, ByteString)
readsBriefly ByteString
xs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
xs of Maybe (Char, ByteString)
Nothing     -> String -> Maybe (Int, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
                                          Just (Char
c,ByteString
cs) -> (Int, ByteString) -> Maybe (Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
128, ByteString
cs)
instance ShortString Int16 where -- Int8 to mattaku onaji
    showsBriefly :: Var -> ByteString -> ByteString
showsBriefly Var
i  = Char -> ByteString -> ByteString
LC.cons (Int -> Char
chr (Var -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Var
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
128))
    readsBriefly :: ByteString -> Maybe (Var, ByteString)
readsBriefly ByteString
xs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
xs of Maybe (Char, ByteString)
Nothing     -> String -> Maybe (Var, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
                                          Just (Char
c,ByteString
cs) -> (Var, ByteString) -> Maybe (Var, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Var
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
128), ByteString
cs)
instance ShortString Int8 where
    showsBriefly :: Int8 -> ByteString -> ByteString
showsBriefly Int8
i  = Char -> ByteString -> ByteString
LC.cons (Int -> Char
chr (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
128))
    readsBriefly :: ByteString -> Maybe (Int8, ByteString)
readsBriefly ByteString
xs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
xs of Maybe (Char, ByteString)
Nothing     -> String -> Maybe (Int8, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
                                          Just (Char
c,ByteString
cs) -> (Int8, ByteString) -> Maybe (Int8, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
128), ByteString
cs)
instance ShortString Word8 where
    showsBriefly :: Word8 -> ByteString -> ByteString
showsBriefly Word8
i  = Char -> ByteString -> ByteString
LC.cons (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i))
    readsBriefly :: ByteString -> Maybe (Word8, ByteString)
readsBriefly ByteString
xs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
xs of Maybe (Char, ByteString)
Nothing     -> String -> Maybe (Word8, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
                                          Just (Char
c,ByteString
cs) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c), ByteString
cs)
instance (ShortString a, ShortString b, ShortString c) => ShortString (a,b,c) where
    showsBriefly :: (a, b, c) -> ByteString -> ByteString
showsBriefly (a
a,b
b,c
c) = a -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly a
a (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly b
b (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly c
c
    readsBriefly :: ByteString -> Maybe ((a, b, c), ByteString)
readsBriefly ByteString
cs = do (a
a,ByteString
ds) <- ByteString -> Maybe (a, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
cs
                         (b
b,ByteString
es) <- ByteString -> Maybe (b, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                         (c
c,ByteString
fs) <- ByteString -> Maybe (c, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
es
                         ((a, b, c), ByteString) -> Maybe ((a, b, c), ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c),ByteString
fs)
instance (ShortString a, ShortString b) => ShortString (a,b) where
    showsBriefly :: (a, b) -> ByteString -> ByteString
showsBriefly (a
a,b
b) = a -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly a
a (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly b
b
    readsBriefly :: ByteString -> Maybe ((a, b), ByteString)
readsBriefly ByteString
cs = do (a
a,ByteString
ds) <- ByteString -> Maybe (a, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
cs
                         (b
b,ByteString
es) <- ByteString -> Maybe (b, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                         ((a, b), ByteString) -> Maybe ((a, b), ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b),ByteString
es)
instance ShortString () where
    showsBriefly :: () -> ByteString -> ByteString
showsBriefly () = ByteString -> ByteString
forall a. a -> a
id
    readsBriefly :: ByteString -> Maybe ((), ByteString)
readsBriefly ByteString
cs = ((), ByteString) -> Maybe ((), ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((),ByteString
cs)
instance ShortString Type where
    showsBriefly :: Type -> ByteString -> ByteString
showsBriefly (TV Int8
i)    = Char -> ByteString -> ByteString
LC.cons Char
'V' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Int8
i
    showsBriefly (TC Int8
i)    = Char -> ByteString -> ByteString
LC.cons Char
'C' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Int8
i
    showsBriefly (TA Type
f Type
x)  = Char -> ByteString -> ByteString
LC.cons Char
'A' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Type
f (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Type
x
    showsBriefly (Type
a :-> Type
r) = Char -> ByteString -> ByteString
LC.cons Char
'>' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Type
a (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ByteString -> ByteString
forall a. ShortString a => a -> ByteString -> ByteString
showsBriefly Type
r
    readsBriefly :: ByteString -> Maybe (Type, ByteString)
readsBriefly ByteString
cs = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
cs of Just (Char
'V',ByteString
ds) -> do (Int8
i, ByteString
es) <- ByteString -> Maybe (Int8, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                                                              (Type, ByteString) -> Maybe (Type, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Type
TV Int8
i, ByteString
es)
                                          Just (Char
'C',ByteString
ds) -> do (Int8
i, ByteString
es) <- ByteString -> Maybe (Int8, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                                                              (Type, ByteString) -> Maybe (Type, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Type
TC Int8
i, ByteString
es)
                                          Just (Char
'A',ByteString
ds) -> do (Type
f, ByteString
es) <- ByteString -> Maybe (Type, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                                                              (Type
x, ByteString
fs) <- ByteString -> Maybe (Type, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
es
                                                              (Type, ByteString) -> Maybe (Type, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type -> Type
TA Type
f Type
x, ByteString
fs)
                                          Just (Char
'>',ByteString
ds) -> do (Type
a, ByteString
es) <- ByteString -> Maybe (Type, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
ds
                                                              (Type
r, ByteString
fs) <- ByteString -> Maybe (Type, ByteString)
forall a. ShortString a => ByteString -> Maybe (a, ByteString)
readsBriefly ByteString
es
                                                              (Type, ByteString) -> Maybe (Type, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
aType -> Type -> Type
:->Type
r, ByteString
fs)
                                          Maybe (Char, ByteString)
_             -> String -> Maybe (Type, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"