scanAndParse export

1 files changed, 22 insertions, 55 deletions

diff --git a/ScanningParser.hs b/ScanningParser.hs
index 9eed080..a0a5d23 100644
--- a/ScanningParser.hs
+++ b/ScanningParser.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 module ScanningParser
  ( ScanningParser(..)
+ , scanAndParse
  ) where
 
 import Data.Maybe
@@ -10,10 +11,6 @@ import Control.Applicative
 import Control.Monad
 import Data.Monoid
 
--- | Utility to operate on the first item of a pair.
-first :: (a->b) -> (a,c) -> (b,c)
-first f (x,y) = (f x, y)
-
 -- | This type provides the means to parse a stream of 'tok' and extract all
 -- the 'obj' parses that occur.
 --
@@ -29,6 +26,25 @@ data ScanningParser tok obj = forall partial. ScanningParser
     -- parse an object and return the unconsumed tokens.
     }
 
+instance Functor (ScanningParser a) where
+    fmap f (ScanningParser ffst pbody)
+        = ScanningParser ffst (\b -> first (fmap f) . pbody b)
+     where
+        first f (x,y) = (f x, y)
+
+
+instance Monoid (ScanningParser a b) where
+    mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
+    mappend (ScanningParser ffstA pbdyA)
+            (ScanningParser ffstB pbdyB)
+     = ScanningParser ffst pbody
+     where
+        ffst x = mplus (Left  <$> ffstA x)
+                       (Right <$> ffstB x)
+        pbody (Left apart)  = pbdyA apart
+        pbody (Right bpart) = pbdyB bpart
+
+
 -- | Apply a 'ScanningParser' to a list of tokens, yielding a list of parsed
 -- objects.
 scanAndParse :: ScanningParser a c -> [a] -> [c]
@@ -36,7 +52,8 @@ scanAndParse psr [] = []
 scanAndParse psr@(ScanningParser ffst pbdy) ts = do
     (b,xs) <- take 1 $ mapMaybe findfst' tss
     let (mc,ts') = pbdy b xs
-    maybe [] (:scanAndParse psr ts') mc
+        rec = scanAndParse psr ts'
+    maybe rec (:rec) mc
  where
     tss = tails ts
     findfst' ts = do
@@ -44,53 +61,3 @@ scanAndParse psr@(ScanningParser ffst pbdy) ts = do
         b <- ffst x
         return (b,drop 1 ts)
 
-instance Functor (ScanningParser a) where
-    fmap f (ScanningParser ffst pbody)
-        = ScanningParser ffst (\b -> first (fmap f) . pbody b)
-
-instance Monoid (ScanningParser a b) where
-    mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
-    mappend a b = a <+> b
-
--- | Combine two parsers into one that tries either.
-(<+>) ::
-    ScanningParser tok obj
-    -> ScanningParser tok obj
-    -> ScanningParser tok obj
-parserA@(ScanningParser ffstA pbdyA) <+> parserB@(ScanningParser ffstB pbdyB)  = ScanningParser ffst pbody
- where
-    ffst x = mplus (Left  <$> ffstA x)
-                   (Right <$> ffstB x)
-    pbody (Left apart)  = pbdyA apart
-    pbody (Right bpart) = pbdyB bpart
-
-{-
-
--- | Map a parser into a sum type. This is useful for combining multiple
--- 'ScanningParser's for a single pass scan.
---
--- HELP: Can this be done with one function argument instead of three?
-mapParser ::
-    (c -> y)
-    -> (b -> x)
-    -> (x -> b)
-    -> ScanningParser a b c
-    -> ScanningParser a x y
-mapParser g f invf psr =
-    psr { findFirst = fmap f . findFirst psr
-        , parseBody = \b as -> first (fmap g) $ parseBody psr (invf b) as
-        }
-
--- | map 'Right' over a 'ScanningParser'
---
--- > mapRight = mapParser Right Right (\(Right x)->x)
-mapRight :: ScanningParser a b c -> ScanningParser a (Either x b) (Either y c)
-mapRight = mapParser Right Right (\(Right x)->x)
-
--- | map 'Left' over a 'ScanningParser'
---
--- > mapLeft = mapParser Left Left (\(Left x)->x)
-mapLeft :: ScanningParser a b c -> ScanningParser a (Either b x) (Either c y)
-mapLeft  = mapParser Left Left (\(Left x)->x)
-
--}