iteratee-parsec (empty) → 0.0.1
raw patch · 6 files changed
+338/−0 lines, 6 filesdep +ListLikedep +basedep +iterateesetup-changed
Dependencies added: ListLike, base, iteratee, parsec, transformers
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- iteratee-parsec.cabal +29/−0
- src/Text/Parsec/Iteratee.hs +19/−0
- src/Text/Parsec/Iteratee/Chunk.hs +78/−0
- src/Text/Parsec/Iteratee/LinkedList.hs +188/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2009 Maciej Piechotka, John Lato++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ iteratee-parsec.cabal view
@@ -0,0 +1,29 @@+Name: iteratee-parsec+Version: 0.0.1+Synopsis: Package allowing parsec parser initeratee+Description: Package providing instances of Stream in+ IterateeG monad.+Category: Data, Parsing+License: MIT+License-file: LICENSE+Author: John Lato,+ Maciej Piechotka+Maintainer: uzytkownik2@gmail.com+Build-Type: Simple+Cabal-Version: >=1.4++Library+ Build-Depends: base >= 3 && < 5,+ iteratee,+ ListLike,+ parsec >= 3,+ transformers+ Exposed-Modules: Text.Parsec.Iteratee,+ Text.Parsec.Iteratee.Chunk,+ Text.Parsec.Iteratee.LinkedList+ HS-Source-Dirs: src+ Extensions: FlexibleContexts,+ FlexibleInstances,+ MultiParamTypeClasses,+ UndecidableInstances+ GHC-Options: -Wall
+ src/Text/Parsec/Iteratee.hs view
@@ -0,0 +1,19 @@+{- |+Module : $Header$+Description : Module providing implementations of Stream in IterateeG monad.+Copyright : (c) Maciej Piechotka+License : MIT++Maintainer : uzytkownik2@gmail.com+Stability : none+Portability : portable+-}+module Text.Parsec.Iteratee+ (+ safeParsecIteratee,+ safeParsecIterateeShort,+ parsecIteratee+ )+where+import Text.Parsec.Iteratee.Chunk+import Text.Parsec.Iteratee.LinkedList
+ src/Text/Parsec/Iteratee/Chunk.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+Module : $Header$+Description : Module providing simple implementation based on accumulating+ chunks.+Copyright : (c) John Lato+License : Public domain++Maintainer : uzytkownik2@gmail.com+Stability : none+Portability : portable++Module providing simple implementation based on accumulating chunks.+It is optimised for short parsers.+-}+module Text.Parsec.Iteratee.Chunk+ (+ safeParsecIterateeShort+ )+where++import qualified Data.Iteratee as I+import Data.Iteratee.Base (IterateeG (..), StreamG (..), IterGV (..))+import qualified Data.Iteratee.Base.StreamChunk as SC+import Control.Monad+import Control.Applicative+import qualified Data.ListLike as LL+import Data.Monoid+import Text.Parsec++-- |Create an Iteratee from a ParsecT parser.+-- This is most efficient for relatively smaller parsers (< 1e5 chars),+-- and becomes increasingly inefficient as the parser size increases.+-- If the parse fails, no input is consumed. If the parse succeeds,+-- any data remaining after the parse is available to the iteratee.+safeParsecIterateeShort+ :: (Stream Int (IterateeG s t m) t, Monad m, SC.StreamChunk s t) =>+ ParsecT Int u (IterateeG s t m) a+ -> u+ -> SourceName+ -> IterateeG s t m (Either ParseError a)+safeParsecIterateeShort p u sn = do + res <- runParserT ((,) <$> p <*> getInput ) u sn 0+ case res of+ Right (a, lpos) -> I.drop lpos >> return (Right a)+ Left err -> return $ Left err++-- |Make an Iteratee instance of Parsec's Stream class.+-- This is only efficient for relatively small parsers (on order of 1e5 chars).+instance (Monad m, SC.StreamChunk s el) =>+ Stream Int (IterateeG s el m) el where+ uncons n = (liftM . fmap) (\res -> (res, n+1)) $ peekAt n+++-- |Peek @n@ points ahead into the stream. This will force chunks if+-- necessary.+peekAt :: (SC.StreamChunk s el, Monad m) => Int -> IterateeG s el m (Maybe el)+peekAt 0 = I.peek+peekAt n = IterateeG step+ where+ step c@(Chunk xs)+ | SC.null xs = return $ Cont (peekAt n) Nothing+ | n < SC.length xs = return $ Done (Just $ LL.index xs n) c+ | True = return $ Cont (nextChunk xs) Nothing+ step str = return $ Done Nothing str+ nextChunk xs = IterateeG step2+ where+ step2 (Chunk xs')+ | SC.null xs' = return $ Cont (nextChunk xs) Nothing+ | n < (SC.length xs + SC.length xs') =+ let nxs = xs `mappend` xs'+ in return $ Done (Just $ LL.index nxs n) (Chunk nxs)+ | True = let nxs = xs `mappend` xs'+ in return $ Cont (nextChunk nxs) Nothing+ step2 str = return $ Done Nothing str
+ src/Text/Parsec/Iteratee/LinkedList.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+Module : $Header$+Description : Module providing simple implementation based on mutable linked+ list.+Copyright : (c) Maciej Piechotka+License : MIT++Maintainer : uzytkownik2@gmail.com+Stability : none+Portability : portable++Module providing simple implementation based on mutable linked list.+It is optimised for longer parsers.+-}+module Text.Parsec.Iteratee.LinkedList+ (+ Reference(..),+ Cursor,+ NextCursor,+ mkCursor,+ parsecIteratee,+ safeParsecIteratee,+ )+where+import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.ST+import Control.Monad.Trans+import Data.Maybe+import Data.Monoid+import Data.Iteratee+import Data.Iteratee.Base.StreamChunk (StreamChunk)+import Data.IORef+import qualified Data.ListLike as LL+import Data.STRef+import Text.Parsec+import Text.Parsec.Pos++-- | Class notifing a reference in monad.+-- Probably should be in separate module.+class Monad m => Reference r m where+ -- | Create new reference+ newRef :: a -- ^ An initial value+ -> m (r a) -- ^ A new reference+ -- | Reads a reference+ readRef :: r a -- ^ Reference+ -> m a -- ^ Value hold by reference+ -- | Write to reference+ writeRef :: r a -- ^ Reference+ -> a -- ^ New value+ -> m ()+ -- | Modify the reference. Default implementation is provided but it MUST be+ -- overloaded if the reference is atomic to provide an atomic write+ modifyRef :: r a -- ^ Reference+ -> (a -> m (a, b)) -- ^ Computation+ -> m b -- ^ Result of computation+ modifyRef r f = readRef r >>= f >>= \(a, b) -> writeRef r a >> return b++instance Reference IORef IO where+ newRef = newIORef+ readRef = readIORef+ writeRef = writeIORef++instance Reference (STRef s) (ST s) where+ newRef = newSTRef+ readRef = readSTRef+ writeRef = writeSTRef++instance Reference MVar IO where+ newRef = newMVar+ readRef = readMVar+ writeRef = putMVar++-- | Specify the 3 possible states of next cursor - existence, non-existence+-- and not being evaluated+data (Monad m, Reference r m, StreamChunk c el) => NextCursor r m c el+ -- | Points to next cursor+ = NextCursor (Cursor r m c el)+ -- | States that next cursor does not exists+ | None+ -- | Next cursor is not evaluated+ | Uneval++-- | Cursor holds current value and reference to possible next cursor+data (Monad m, Reference r m, StreamChunk c el) => Cursor r m c el = + Cursor (r (NextCursor r m c el)) (c el)++-- | Creates new cursor+mkCursor :: (Monad m, Reference r m, StreamChunk c el) => m (Cursor r m c el)+mkCursor = newRef Uneval >>= \r -> (return $! Cursor r LL.empty)++instance (Monad m, Reference r m, StreamChunk c el) =>+ Stream (Cursor r m c el) (IterateeG c el m) el where+ uncons = unconsStream++unconsStream :: (Monad m, Reference r m, StreamChunk c el)+ => Cursor r m c el+ -> IterateeG c el m (Maybe (el, Cursor r m c el))+unconsStream p@(Cursor r c)+ | LL.null c = IterateeG $ \st -> join $ modifyRef r $ unconsCursor st p+ | otherwise = return $! justUnconsCursor p++unconsCursor :: forall r m c el. (Monad m, Reference r m, StreamChunk c el)+ => StreamG c el+ -> Cursor r m c el+ -> NextCursor r m c el+ -> m (NextCursor r m c el,+ m (IterGV c el m (Maybe (el, Cursor r m c el))))+unconsCursor st _ rv@(NextCursor p@(Cursor r c))+ | LL.null c = return $! (rv, join $ modifyRef r $ unconsCursor st p)+ | otherwise = return $! (rv, return $! Done (justUnconsCursor p) st)+unconsCursor st _ rv@None+ = return $! (rv, return $! Done Nothing st)+unconsCursor (Chunk c) p rv@Uneval+ | LL.null c = return $! (rv, return $! Cont (unconsStream p) Nothing)+ | otherwise = do r <- newRef Uneval :: m (r (NextCursor r m c el))+ let p' = Cursor r c+ ra = Done (justUnconsCursor p') (Chunk LL.empty)+ return $! (NextCursor p', return $! ra)+unconsCursor st@(EOF Nothing) _ Uneval+ = return $! (None, return $! Done Nothing st)+unconsCursor (EOF (Just e)) _ rv@Uneval+ = return $! (rv, return $! Cont (throwErr e) (Just e))++justUnconsCursor :: (Monad m, Reference r m, StreamChunk c el) =>+ Cursor r m c el -> Maybe (el, Cursor r m c el)+justUnconsCursor (Cursor r c) = Just $! (LL.head c, Cursor r $ LL.tail c)++concatCursor :: (Monad m, Reference r m, StreamChunk c el)+ => Cursor r m c el -> m (c el)+concatCursor c = liftM mconcat (concatCursor' c)++concatCursor' :: (Monad m, Reference r m, StreamChunk c el)+ => Cursor r m c el -> m [c el]+concatCursor' (Cursor r v) =+ liftM2 (:) (return v) (readRef r >>= concatNextCursor')++concatNextCursor' :: (Monad m, Reference r m, StreamChunk c el)+ => NextCursor r m c el -> m [c el]+concatNextCursor' (NextCursor c) = concatCursor' $! c+concatNextCursor' _ = return $! []++-- | Runs parser. If it suceed the remaining part of stream stands in stream,+-- however if it fails the stream is not in defined state.+parsecIteratee :: (Monad m, Reference r m, StreamChunk c el)+ => ParsecT (Cursor r m c el) u (IterateeG c el m) a+ -- ^ Parser to run+ -> u -- ^ A user state+ -> SourceName -- ^ Source name+ -> IterateeG c el m (Either ParseError a)+parsecIteratee p u sn = do+ c <- lift mkCursor+ res <- runParserT (liftM2 (,) p getInput) u sn c+ case res of+ Right (a, c') -> do sc <- lift $ concatCursor c'+ liftI $! Done (Right a) $! Chunk $! sc+ Left err -> return $ Left err++-- | Runs parser. If it suceed the remaining part of stream stands in stream,+-- however if it fails everything stands in stream.+safeParsecIteratee :: (Monad m, Reference r m, StreamChunk c el)+ => ParsecT (Cursor r m c el) u (IterateeG c el m) a+ -- ^ Parser to run+ -> u -- ^ A user state+ -> SourceName -- ^ Source name+ -> IterateeG c el m (Either ParseError a)+safeParsecIteratee p u sn = do+ c <- lift mkCursor+ Right (c', res) <- runParserT (parsecSafe p) u sn c+ sc <- lift $ concatCursor c'+ liftI $! Done res $! Chunk $! sc++parsecSafe :: Monad m+ => ParsecT s u m a+ -> ParsecT s u m (s, Either ParseError a)+parsecSafe (ParsecT p) = ParsecT $ \s -> do+ r <- join (unConsume `liftM` p s)+ case r of+ Error pe -> let rp = Ok (stateInput s, Left pe) s (unknownError s)+ in return $! Empty $ return $! rp+ Ok v s' _ -> let rp = Ok (stateInput s', Right v) s' (unknownError s')+ in return $! Consumed $! return $! rp+ where unConsume (Consumed x) = x+ unConsume (Empty x) = x