module Data.Rakhana.Util.Drive where
import qualified Data.ByteString as B
import Data.Typeable
import Control.Exception
import Control.Lens
import Control.Monad.Catch (MonadThrow(..))
import Data.Attoparsec.ByteString
import Pipes.Safe ()
import Data.Rakhana.Internal.Parsers
import Data.Rakhana.Internal.Types
import Data.Rakhana.Tape
data ParsingException = ParsingException String deriving (Show, Typeable)
instance Exception ParsingException
parseRepeatedly :: Monad m => Int -> Parser a -> Drive m (Either String a)
parseRepeatedly bufferSize parser
= loop Nothing
where
loop mK
= do bs <- driveGet bufferSize
case maybe (parse parser bs) ($ bs) mK of
Fail _ _ e -> return $ Left e
Partial k -> loop $ Just k
Done r a -> do let len = fromIntegral $ B.length r
driveModifySeek (\i -> i len)
return $ Right a
driveParse :: MonadThrow m => Int -> Parser a -> Drive m a
driveParse bufSize parser
= do eR <- parseRepeatedly bufSize parser
case eR of
Left e -> throwM $ ParsingException e
Right a -> return a
driveParseObject :: MonadThrow m => Int -> Drive m (Int, Int, Object)
driveParseObject i
= do rE <- driveParseObjectE i
either (throwM . ParsingException) return rE
driveParseObjectE :: Monad m
=> Int
-> Drive m (Either String (Int, Int, Object))
driveParseObjectE bufSize
= do rE <- parseRepeatedly bufSize parseIndirectObject
case rE of
Left e -> return $ Left e
Right r
| Dict d <- r ^. _3
-> couldBeStreamObject (r ^. _1, r ^. _2) d
| otherwise
-> return $ Right r
where
couldBeStreamObject (idx, gen) d
= do eR <- parseRepeatedly 16 parseStreamHeader
case eR of
Left _
-> return $ Right $ (idx, gen, Dict d)
Right _
-> do p <- driveGetSeek
return $ Right $ (idx, gen, AStream $ Stream d p)