kangaroo 0.2.0 → 0.3.0
raw patch · 10 files changed
+462/−83 lines, 10 files
Files
- demo/MidiRead.hs +1/−4
- kangaroo.cabal +5/−1
- src/Data/ParserCombinators/Kangaroo.hs +49/−6
- src/Data/ParserCombinators/Kangaroo/Combinators.hs +2/−7
- src/Data/ParserCombinators/Kangaroo/ParseMonad.hs +88/−28
- src/Data/ParserCombinators/Kangaroo/Prim.hs +158/−20
- src/Data/ParserCombinators/Kangaroo/Utils.hs +18/−1
- src/Data/ParserCombinators/KangarooRWS.hs +45/−5
- src/Data/ParserCombinators/KangarooReader.hs +49/−6
- src/Data/ParserCombinators/KangarooWriter.hs +47/−5
demo/MidiRead.hs view
@@ -177,10 +177,7 @@ -} -word24be :: MidiParser Word32-word24be = w32be 0 <$> word8 <*> word8 <*> word8 - word8split :: MidiParser (Word8,Word8) word8split = split <$> word8 where@@ -204,7 +201,7 @@ getVarlenText :: MidiParser (Word32,String) -getVarlenText = countPrefixed getVarlen char+getVarlenText = countPrefixed getVarlen anyChar getVarlenBytes :: MidiParser (Word32,[Word8]) getVarlenBytes = countPrefixed getVarlen word8
kangaroo.cabal view
@@ -1,5 +1,5 @@ name: kangaroo-version: 0.2.0+version: 0.3.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -29,6 +29,10 @@ own package . Changelog:+ .+ 0.3.0 Documented the primitive parsers. @char@ renamed @anyChar@+ to match Parsec\'s convention. Rationalized exports from + ParseMonad module. . 0.2.0 Changes to ParseMonad - parsing within a region simplified, temporarily added JoinPrint.
src/Data/ParserCombinators/Kangaroo.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Data.ParserCombinators.Kangaroo--- Copyright : (c) Stephen Tetley 2009, 2010+-- Copyright : (c) Stephen Tetley 2009-2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>@@ -16,12 +16,54 @@ module Data.ParserCombinators.Kangaroo (- module Data.ParserCombinators.Kangaroo.Combinators- , module Data.ParserCombinators.Kangaroo.ParseMonad- , module Data.ParserCombinators.Kangaroo.Prim- , Kangaroo+ Kangaroo , runKangaroo , parse++ -- Re-exports from ParseMonad+ -- * Parser types+ , ParseErr++ -- * Region types+ , RegionCoda(..)+ , RegionName +++ -- * Lift IO actions+ , liftIOAction++ -- * Error reporting and exception handling+ , reportError+ , substError++ -- * Primitive parsers+ , word8+ , satisfy+ , checkWord8+ , opt ++ -- * Query the cursor position+ , position+ , region+ , atEnd+ , lengthRemaining+ , regionSize++ -- * Parse within a region+ , intraparse+ , advance+ , advanceRelative+ , restrict+ , restrictToPos+ + -- * Debug+ , printHexAll+ , printRegionStack ++ , module Data.ParserCombinators.Kangaroo.Combinators+ , module Data.ParserCombinators.Kangaroo.Prim++ ) where import Data.ParserCombinators.Kangaroo.Combinators@@ -34,7 +76,8 @@ runKangaroo :: Kangaroo a -> FilePath -> IO (Either ParseErr a) runKangaroo p filename = runGenKangaroo p () filename >>= \(a,_) -> return a --- jsut runKangaroo here+-- just runKangaroo here+ parse :: Kangaroo a -> FilePath -> IO (Either ParseErr a) parse = runKangaroo
src/Data/ParserCombinators/Kangaroo/Combinators.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Data.ParserCombinators.Kangaroo.Combinators--- Copyright : (c) Stephen Tetley 2009+-- Copyright : (c) Stephen Tetley 2009-2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>@@ -16,8 +16,7 @@ module Data.ParserCombinators.Kangaroo.Combinators ( - satisfy- , manyTill+ manyTill , genericManyTill , manyTillPC , genericManyTillPC@@ -37,10 +36,6 @@ import Control.Applicative import Data.Word--satisfy :: (Word8 -> Bool) -> GenKangaroo ust Word8-satisfy p = word8 >>= \x -> - if p x then return x else reportError $ "satisfy" manyTill :: GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust [a]
src/Data/ParserCombinators/Kangaroo/ParseMonad.hs view
@@ -16,25 +16,34 @@ module Data.ParserCombinators.Kangaroo.ParseMonad (- GenKangaroo++ -- * Parser types+ GenKangaroo -- don't export outside the package , ParseErr- , RegionCoda(..) -- re-export- , RegionName -- re-export- - , getUserSt- , putUserSt- , modifyUserSt - , throwErr+ -- * Region types+ , RegionCoda(..)+ , RegionName ++ -- * Monadic run function+ , runGenKangaroo -- don't export outside the package++ -- * Lift IO actions , liftIOAction- , withSuccess- , runGenKangaroo + -- * Non proper morphisms + , throwErr -- don't export outside the package+ , getUserSt -- don't export outside the package+ , putUserSt -- don't export outside the package+ , modifyUserSt -- don't export outside the package++ -- * Error reporting and exception handling , reportError , substError -- * Primitive parsers , word8+ , satisfy , checkWord8 , opt @@ -78,7 +87,7 @@ type Env = ImageData --- Kangaroo is not a transformer as IO is always at the +-- | Kangaroo is not a transformer as IO is always at the -- \'bottom\' of the effect stack. Like the original Parsec it is -- parametric on user state (refered to as ust). --@@ -86,6 +95,10 @@ getGenKangaroo :: Env -> St -> ust -> IO (Either ParseErr a, St, ust) } +--------------------------------------------------------------------------------+-- Instances and helpers++ fmapKang :: (a -> b) -> GenKangaroo ust a -> GenKangaroo ust b fmapKang f (GenKangaroo x) = GenKangaroo $ \env st ust -> x env st ust `bindIO` \(a,st',ust') -> return (fmap f a, st', ust')@@ -130,14 +143,21 @@ -- I don't think Kangaroo has natural implementations of -- Alternative or MonadPlus.--- My 'proposition' is that the sort of parsing that Kangaroo +--+-- My proposition is that the sort of parsing that Kangaroo -- intends to provide you always now want you want hence there -- is no inbuilt backtracking or support for list-of-successes. --+--------------------------------------------------------------------------------+-- Run... -runGenKangaroo :: GenKangaroo ust a -> ust -> FilePath -> IO (Either ParseErr a,ust)+-- | Primitive monadic run function - other modules should export+-- type specific specializations of this function...+--+runGenKangaroo :: GenKangaroo ust a + -> ust + -> FilePath + -> IO (Either ParseErr a,ust) runGenKangaroo p user_state filename = withBinaryFile filename ReadMode $ \ handle -> do { sz <- hFileSize handle@@ -156,6 +176,8 @@ answer (Right ans) _ = Right ans +--------------------------------------------------------------------------------+-- Non proper morphisms throwErr :: ParseErr -> GenKangaroo ust a throwErr msg = GenKangaroo $ \_ st ust -> return (Left msg, st, ust)@@ -210,8 +232,13 @@ popM = getSt >>= \st -> putSt (pop st) +--------------------------------------------------------------------------------+-- Lift IO actions - we are in the IO ++-- | Lift an IO action into the Kangaroo monad.+-- liftIOAction :: IO a -> GenKangaroo ust a-liftIOAction ma = GenKangaroo $ \_ st ust -> +liftIOAction ma = GenKangaroo $ \ _env st ust -> ma >>= \a -> return (Right a, st, ust) @@ -220,9 +247,12 @@ -- Helpers ----------------------------------------------------------------------------------- -+-- Error reporting +-- | Report a parse error.+--+-- Source position is appended to the supplied error message+-- reportError :: ParseErr -> GenKangaroo ust a reportError s = do posn <- getPos@@ -236,7 +266,14 @@ ] -+-- | 'substError' : @ parser * error_msg -> parser@+--+-- 'substError' is equivalent to Parsec\'s @\<?\>@ combinator.+--+-- Run the supplied parser, if the parse succeeds return the +-- result, otherwise override the original error message with+-- the supplied @error_msg@.+-- substError :: GenKangaroo ust a -> ParseErr -> GenKangaroo ust a substError p msg = GenKangaroo $ \env st ust -> (getGenKangaroo p) env st ust >>= \ ans -> @@ -245,15 +282,14 @@ okay -> return okay -withSuccess :: Bool -> ParseErr -> GenKangaroo ust a -> GenKangaroo ust a-withSuccess False msg _ = throwErr msg-withSuccess True _ mf = mf-- -------------------------------------------------------------------------------- -- Primitive parsers - +-- | Parse a single byte.+--+-- If the cursor is beyond the end of the current region a +-- parse-error is thrown with 'reportError'.+-- word8 :: GenKangaroo ust Word8 word8 = do ix <- getPos@@ -264,6 +300,24 @@ advancePos1 return a +-- | 'satisfy' : @ predicate -> parser @+--+-- Parse a single byte and apply the predicate to it. On @True@ +-- return the parsed byte, on @False@ throw a parse-error with +-- 'reportError'.+--+satisfy :: (Word8 -> Bool) -> GenKangaroo ust Word8+satisfy p = word8 >>= \x -> if p x then return x else reportError $ "satisfy"+++-- | 'checkWord8' : @ predicate -> opt parser @+--+-- Byte parser with backtracking when the match fails.+-- +-- Parse a single byte and apply the predicate to the result. On+-- success return @(Just answer)@, on failure move the cursor +-- position back one and return @Nothing@.+-- checkWord8 :: (Word8 -> Bool) -> GenKangaroo ust (Maybe Word8) checkWord8 check = word8 >>= \ans -> if check ans then return $ Just ans@@ -272,14 +326,20 @@ ---- no 'try' in Kangaroo... --- opt is the nearest to it, opt backtracks the cursor on failure.+-- | Backtracking parser similar to Parsec\'s @try@.+--+-- Try the supplied parser, if the parse succeeds with no+-- parse-errors return @(Just answer)@. If a parse-error is +-- generated, discard the parse-error, return the cursor to the+-- initial position and return @Nothing@.+-- opt :: GenKangaroo ust a -> GenKangaroo ust (Maybe a) opt p = GenKangaroo $ \env st ust -> (getGenKangaroo p) env st ust >>= \ ans -> case ans of (Left _, _, ust') -> return (Right Nothing, st, ust') (Right a, st', ust') -> return (Right $ Just a, st', ust')++ --------------------------------------------------------------------------------
src/Data/ParserCombinators/Kangaroo/Prim.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Data.ParserCombinators.Kangaroo.Prim--- Copyright : (c) Stephen Tetley 2009+-- Copyright : (c) Stephen Tetley 2009-2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>@@ -16,22 +16,40 @@ module Data.ParserCombinators.Kangaroo.Prim (- cstring+ -- * Char and String parsers+ char+ , anyChar+ , text+ , string+ , cstring+ + -- * Byte parsers , w8Zero , getBytes- , char- , text++ -- * Number parsers , int8++ -- ** Word - big endian , word16be+ , word24be , word32be- , word64be + , word64be+ + -- ** Word - little endian , word16le+ , word24le , word32le++ -- ** Int - big endian , int16be , int32be++ -- ** Int - little endian , int16le , int32le + -- ** IEEE754 single precision float , ieeeFloatSP ) where@@ -47,65 +65,185 @@ import Data.Word --- | Read a null-terminated string++-- | Attempt to parse the supplied single character (the supplied +-- char must be in the ASCII range 0-255).+--+-- If the parse succeeds return the char, otherwise a parse-error+-- will be thrown with 'reportError'.+--+char :: Char -> GenKangaroo ust Char+char ch = satisfy (==chi) >> return ch + where + chi = fromIntegral $ ord ch +++-- | Parse any single character. The parser consumes one byte and+-- uses 'chr' to convert it.+--+anyChar :: GenKangaroo ust Char+anyChar = (chr . fromIntegral) <$> word8 +++-- | Parse a string of the supplied length @n@.+--+-- If @n@ is less than or equal to zero the empty string is +-- returned.+--+text :: Int -> GenKangaroo ust String+text i | i <= 0 = return ""+ | otherwise = count i anyChar++-- | Parse the supplied string. All characters should be within +-- the range 0-255.+-- +-- If the parse succeeds return the char, otherwise a parse-error+-- will be thrown with 'reportError'.+--+string :: String -> GenKangaroo ust String+string = (substError `flip` "string" ) . mapM char + ++-- | Parse a null-terminated C-style string.+-- cstring :: GenKangaroo ust String-cstring = manyTill char w8Zero+cstring = manyTill anyChar w8Zero +--------------------------------------------------------------------------------+-- Byte parsers ++-- | Parse the literal @0x00@.+-- w8Zero :: GenKangaroo ust Word8 w8Zero = satisfy (==0) -getBytes :: Integral a => a -> GenKangaroo ust [Word8]-getBytes i = count (fromIntegral i) word8 -char :: GenKangaroo ust Char-char = (chr . fromIntegral) <$> word8 -+-- | Get @n@ bytes. +-- +-- If @n@ is less than or equal to zero an empty list is returned.+--+getBytes :: Integral a => a -> GenKangaroo ust [Word8]+getBytes i | i < 0 = return []+ | otherwise = count (fromIntegral i) word8 -text :: Int -> GenKangaroo ust String-text = count `flip` char-+--------------------------------------------------------------------------------+-- Numbers +-- | Parse a single byte, returning it as an Int8.+-- +-- The conversion from a byte (0-255) to an Int8 uses the Prelude +-- function 'fromIntegral'. +-- +-- The conversion is summarized as:+--+-- > 0..127 = 0..127+-- > 128 = -128+-- > 129 = -127+-- > 130 = -126+-- > ...+-- > 254 = -2+-- > 255 = -1 +-- >+-- > wtoi :: Word8 -> Int8+-- > wtoi i | i < 128 = i+-- > | otherwise = -128 + (clearBit i 7)+-- int8 :: GenKangaroo ust Int8-int8 = (fromIntegral . unwrap) <$> word8- where- unwrap :: Word8 -> Int- unwrap i | i > 128 = (fromIntegral i) - 256- | otherwise = fromIntegral i+int8 = fromIntegral <$> word8 +--------------------------------------------------------------------------------+-- Data.Word ++-- | Parse a Word16 in big endian form.+-- word16be :: GenKangaroo ust Word16 word16be = w16be <$> word8 <*> word8 +-- | Parse a \"Word24\" in big endian form.+-- +-- 3 bytes are read - the answer is returned as a Word32.+--+word24be :: GenKangaroo ust Word32+word24be = w32be 0 <$> word8 <*> word8 <*> word8++-- | Parse a Word32 in big endian form.+-- word32be :: GenKangaroo ust Word32 word32be = w32be <$> word8 <*> word8 <*> word8 <*> word8 +-- | Parse a Word64 in big endian form.+-- word64be :: GenKangaroo ust Word64 word64be = w64be <$> word8 <*> word8 <*> word8 <*> word8 <*> word8 <*> word8 <*> word8 <*> word8 ++-- | Parse a Word16 in little endian form.+-- word16le :: GenKangaroo ust Word16 word16le = w16le <$> word8 <*> word8 +-- | Parse a \"Word24\" in little endian form.+--+-- 3 bytes are read - the answer is returned as a Word32.+--+word24le :: GenKangaroo ust Word32+word24le = w24le <$> word8 <*> word8 <*> word8+++-- | Parse a Word32 in little endian form.+-- word32le :: GenKangaroo ust Word32 word32le = w32le <$> word8 <*> word8 <*> word8 <*> word8 +--------------------------------------------------------------------------------+-- Data.Int++++-- | Parse an Int16 in big endian form.+-- +-- The ans is parsed as a Word16 (big endian) then converted to +-- an Int16 using the Prelude function 'fromIntegral'.+-- int16be :: GenKangaroo ust Int16 int16be = i16be <$> word8 <*> word8 ++-- | Parse an Int32 in big endian form.+-- +-- The ans is parsed as a Word32 (big endian) then converted to +-- an Int32 using the Prelude function 'fromIntegral'.+-- int32be :: GenKangaroo ust Int32 int32be = i32be <$> word8 <*> word8 <*> word8 <*> word8 +-- | Parse an Int16 in little endian form.+-- +-- The ans is parsed as a Word16 (little endian) then converted +-- to an Int16 using the Prelude function 'fromIntegral'.+-- int16le :: GenKangaroo ust Int16 int16le = i16le <$> word8 <*> word8 +-- | Parse an Int32 in little endian form.+-- +-- The ans is parsed as a Word32 (little endian) then converted +-- to an Int32 using the Prelude function 'fromIntegral'.+-- int32le :: GenKangaroo ust Int32 int32le = i32le <$> word8 <*> word8 <*> word8 <*> word8 +-- | Parse an 4-byte IEEE single precision float.+-- +-- NOTE - THIS FUNCTION IS UNTESTED!+-- ieeeFloatSP :: Fractional a => GenKangaroo ust a ieeeFloatSP = unpackIEEESingle <$> word8 <*> word8 <*> word8 <*> word8
src/Data/ParserCombinators/Kangaroo/Utils.hs view
@@ -33,10 +33,11 @@ -- * numbers from Word8 , w16be , w32be+ , w64be , w16le+ , w24le , w32le- , w64be , i16be , i32be@@ -125,10 +126,26 @@ -------------------------------------------------------------------------------- +-- fromIntegral on Word8+-- 0..127 = 0..127+-- 128 = -128+-- 129 = -127+-- 130 = -126+-- ....+-- 254 = -2+-- 255 = -1 +-- conviw :: Word8 -> Int8+-- conviw i | i < 128 = i+-- | otherwise = -128 + (clearBit i 7)++ w16le :: Word8 -> Word8 -> Word16 w16le a b = fromIntegral a + (shiftL8 b)++w24le :: Word8 -> Word8 -> Word8 -> Word32+w24le a b c = fromIntegral a + (shiftL8 b) + (shiftL16 c) w32le :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 w32le a b c d = fromIntegral a + (shiftL8 b) + (shiftL16 c) + (shiftL24 d)
src/Data/ParserCombinators/KangarooRWS.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Data.ParserCombinators.KangarooRWS--- Copyright : (c) Stephen Tetley 2009, 2010+-- Copyright : (c) Stephen Tetley 2009-2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>@@ -16,10 +16,7 @@ module Data.ParserCombinators.KangarooRWS (- module Data.ParserCombinators.Kangaroo.Combinators- , module Data.ParserCombinators.Kangaroo.ParseMonad- , module Data.ParserCombinators.Kangaroo.Prim- , Kangaroo+ Kangaroo , parse , runKangaroo , evalKangaroo@@ -30,6 +27,49 @@ , gets , tell , ask++ -- Re-exports from ParseMonad+ -- * Parser types+ , ParseErr++ -- * Region types+ , RegionCoda(..)+ , RegionName +++ -- * Lift IO actions+ , liftIOAction++ -- * Error reporting and exception handling+ , reportError+ , substError++ -- * Primitive parsers+ , word8+ , satisfy+ , checkWord8+ , opt ++ -- * Query the cursor position+ , position+ , region+ , atEnd+ , lengthRemaining+ , regionSize++ -- * Parse within a region+ , intraparse+ , advance+ , advanceRelative+ , restrict+ , restrictToPos+ + -- * Debug+ , printHexAll+ , printRegionStack ++ , module Data.ParserCombinators.Kangaroo.Combinators+ , module Data.ParserCombinators.Kangaroo.Prim ) where
src/Data/ParserCombinators/KangarooReader.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Data.ParserCombinators.KangarooReader--- Copyright : (c) Stephen Tetley 2009, 2010+-- Copyright : (c) Stephen Tetley 2009-2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>@@ -16,20 +16,63 @@ module Data.ParserCombinators.KangarooReader (- module Data.ParserCombinators.Kangaroo.Combinators- , module Data.ParserCombinators.Kangaroo.ParseMonad- , module Data.ParserCombinators.Kangaroo.Prim- , Kangaroo++ -- * Parser tpye + Kangaroo+ , parse , runKangaroo , ask + -- Re-exports from ParseMonad+ -- * Parser types+ , ParseErr++ -- * Region types+ , RegionCoda(..)+ , RegionName +++ -- * Lift IO actions+ , liftIOAction++ -- * Error reporting and exception handling+ , reportError+ , substError++ -- * Primitive parsers+ , word8+ , satisfy+ , checkWord8+ , opt ++ -- * Query the cursor position+ , position+ , region+ , atEnd+ , lengthRemaining+ , regionSize++ -- * Parse within a region+ , intraparse+ , advance+ , advanceRelative+ , restrict+ , restrictToPos+ + -- * Debug+ , printHexAll+ , printRegionStack +++ , module Data.ParserCombinators.Kangaroo.Combinators+ , module Data.ParserCombinators.Kangaroo.Prim+ ) where import Data.ParserCombinators.Kangaroo.Combinators import Data.ParserCombinators.Kangaroo.ParseMonad import Data.ParserCombinators.Kangaroo.Prim-import Data.ParserCombinators.Kangaroo.Utils import Control.Monad ( liftM )
src/Data/ParserCombinators/KangarooWriter.hs view
@@ -16,18 +16,60 @@ module Data.ParserCombinators.KangarooWriter (- module Data.ParserCombinators.Kangaroo.Combinators- , module Data.ParserCombinators.Kangaroo.ParseMonad- , module Data.ParserCombinators.Kangaroo.Prim- , Kangaroo++ Kangaroo , parse , runKangaroo , tell + -- Re-exports from ParseMonad+ -- * Parser types+ , ParseErr++ -- * Region types+ , RegionCoda(..)+ , RegionName +++ -- * Lift IO actions+ , liftIOAction++ -- * Error reporting and exception handling+ , reportError+ , substError++ -- * Primitive parsers+ , word8+ , satisfy+ , checkWord8+ , opt ++ -- * Query the cursor position+ , position+ , region+ , atEnd+ , lengthRemaining+ , regionSize++ -- * Parse within a region+ , intraparse+ , advance+ , advanceRelative+ , restrict+ , restrictToPos+ + -- * Debug+ , printHexAll+ , printRegionStack ++ , module Data.ParserCombinators.Kangaroo.Combinators+ , module Data.ParserCombinators.Kangaroo.Prim++ ) where import Data.ParserCombinators.Kangaroo.Combinators-import Data.ParserCombinators.Kangaroo.ParseMonad+import Data.ParserCombinators.Kangaroo.ParseMonad import Data.ParserCombinators.Kangaroo.Prim import Data.Monoid