module Data.Repa.Convert.Format.Lists
(
FixAsc (..)
, VarAsc (..)
, VarString (..))
where
import Data.Repa.Convert.Format.Binary
import Data.Repa.Convert.Format.Base
import Data.Monoid
import Data.Word
import Data.Char
import qualified Foreign.Storable as S
import qualified Foreign.Ptr as S
import Prelude hiding (fail)
data FixAsc = FixAsc Int deriving (Eq, Show)
instance Format FixAsc where
type Value (FixAsc) = String
fieldCount _ = 1
minSize (FixAsc len) = len
fixedSize (FixAsc len) = Just len
packedSize (FixAsc len) _ = Just len
instance Packable FixAsc where
pack (FixAsc len) xs
| length xs == len
= Packer $ \buf k
-> do mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x))
$ zip [0 .. len 1] xs
k (S.plusPtr buf len)
| otherwise
= Packer $ \_ _ -> return Nothing
unpack (FixAsc len)
= Unpacker $ \start end _stop fail eat
-> do
let lenBuf = S.minusPtr end start
if lenBuf < len
then fail
else
do let load_unpackChar o
= do x :: Word8 <- S.peekByteOff start o
return $ chr $ fromIntegral x
xs <- mapM load_unpackChar [0 .. len 1]
eat (S.plusPtr start len) xs
data VarAsc = VarAsc deriving (Eq, Show)
instance Format (VarAsc) where
type Value VarAsc = String
fieldCount _ = 1
minSize _ = 0
fixedSize VarAsc = Nothing
packedSize VarAsc xs = Just $ length xs
instance Packable VarAsc where
pack VarAsc xx
= case xx of
[] -> mempty
(x : xs) -> pack Word8be (w8 $ ord x) <> pack VarAsc xs
unpack VarAsc
= Unpacker $ \start end stop _fail eat
-> do (ptr, str) <- unpackAsc start end stop
eat ptr str
unpackAsc
:: S.Ptr Word8
-> S.Ptr Word8
-> (Word8 -> Bool)
-> IO (S.Ptr Word8, [Char])
unpackAsc start end stop
= go start []
where go !ptr !acc
| ptr >= end
= return (ptr, reverse acc)
| otherwise
= do w :: Word8 <- S.peek ptr
if stop w
then do
return (ptr, reverse acc)
else do
let !ptr' = S.plusPtr ptr 1
go ptr' ((chr $ fromIntegral w) : acc)
data VarString = VarString deriving (Eq, Show)
instance Format VarString where
type Value VarString = String
fieldCount _ = 1
minSize _ = 2
fixedSize _ = Nothing
packedSize VarString xs
= Just $ length $ show xs
instance Packable VarString where
pack VarString xx
= pack VarAsc (show xx)
unpack VarString
= Unpacker $ \start end _stop fail eat
-> do r <- unpackString start end
case r of
Nothing -> fail
Just (start', str) -> eat start' str
unpackString
:: S.Ptr Word8
-> S.Ptr Word8
-> IO (Maybe (S.Ptr Word8, [Char]))
unpackString start end
= open start
where
open !ptr
| ptr >= end
= return $ Nothing
| otherwise
= do w :: Word8 <- S.peek ptr
let !ptr' = S.plusPtr ptr 1
case chr $ fromIntegral w of
'"' -> go_body ptr' []
_ -> return Nothing
go_body !ptr !acc
| ptr >= end
= return $ Just (ptr, reverse acc)
| otherwise
= do w :: Word8 <- S.peek ptr
let !ptr' = S.plusPtr ptr 1
case chr $ fromIntegral w of
'"' -> return $ Just (ptr', reverse acc)
'\\' -> go_escape ptr' acc
c -> go_body ptr' (c : acc)
go_escape !ptr !acc
| ptr >= end
= return Nothing
| otherwise
= do w :: Word8 <- S.peek ptr
let ptr' = S.plusPtr ptr 1
case chr $ fromIntegral w of
'a' -> go_body ptr' ('\a' : acc)
'b' -> go_body ptr' ('\b' : acc)
'f' -> go_body ptr' ('\f' : acc)
'n' -> go_body ptr' ('\n' : acc)
'r' -> go_body ptr' ('\r' : acc)
't' -> go_body ptr' ('\t' : acc)
'v' -> go_body ptr' ('\v' : acc)
'\\' -> go_body ptr' ('\\' : acc)
'"' -> go_body ptr' ('"' : acc)
_ -> return Nothing
w8 :: Integral a => a -> Word8
w8 = fromIntegral