Make ParserHS more intelligent about spaces and comments

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index 7843e1227c2b91dfc758492f59f6b35774e24382..7da660d670573836ebbc457f4f4b10b724967706 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -197,7 +197,7 @@ term  = token $ choice
       [       parens texpr
       ,       spanned $ TVar <$> (bsf $ ident dynaVarStyle)
 
-      ,       spanned $ mkta <$> (colon *> term) <* spaces <*> term
+      ,       spanned $ mkta <$> (colon *> term) <* whiteSpace <*> term
 
       , try $ spanned $ TNumeric <$> naturalOrDouble
 
@@ -251,7 +251,7 @@ dtexpr = unDL texpr
 -- we hope is a rule.  
 rulepfx :: DeltaParsing f => f ([Spanned Term] -> Spanned Term -> Rule)
 rulepfx = Rule <$> term
-               <*  spaces
+               <*  whiteSpace
                <*> (bsf $ ident dynaOperStyle <?> "Aggregator")
 
 rule :: DeltaParsing m => m Rule
@@ -274,20 +274,22 @@ rule = choice [
   hrss = highlight ReservedOperator . spanned . symbol 
 
 drule :: DeltaParsing m => m (Spanned Rule)
-drule = spanned rule
+drule = unDL (spanned rule)
 
 ------------------------------------------------------------------------}}}
 -- Lines                                                                {{{
 
 progline :: DeltaParsing m => m (Spanned Line)
-progline  = spanned $ choice [ LRule <$> drule
-                             , LPragma <$> (symbol ":-" *> spaces *> texpr)
-                             ]
+progline  = do
+  whiteSpace
+  spanned (choice [ LRule <$> drule
+                  , LPragma <$> (symbol ":-" *> whiteSpace *> texpr)
+                  ])
 
 dline :: DeltaParsing m => m (Spanned Line)
 dline = unDL (progline <* optional (char '.') <* optional newline)
 
 dlines :: DeltaParsing m => m [Spanned Line]
-dlines = unDL (progline `sepEndBy` (char '.' <* spaces))
+dlines = unDL (progline `sepEndBy` (char '.' <* whiteSpace))
 
 ------------------------------------------------------------------------}}}

diff --git a/src/Dyna/ParserHS/Selftest.hs b/src/Dyna/ParserHS/Selftest.hs
index 76a3b196e92230688c1c548f995d40adb140da86..785927f60cae305c01f60af516876547a0621479 100644 (file)
--- a/src/Dyna/ParserHS/Selftest.hs
+++ b/src/Dyna/ParserHS/Selftest.hs
@@ -18,6 +18,7 @@ module Dyna.ParserHS.Selftest where
 
 -- import           Control.Applicative ((<*))
 import           Data.ByteString (ByteString)
+import qualified Data.ByteString                     as B
 -- import           Data.Foldable (toList)
 -- import           Data.Monoid (mempty)
 -- import qualified Data.Sequence                       as S
@@ -141,6 +142,7 @@ case_failIncompleteExpr :: Assertion
 case_failIncompleteExpr = checkParseFail dterm "foo +"
   "(interactive):1:5: error: expected: \"(\",\n    end of input\nfoo +<EOF> "
 
+------------------------------------------------------------------------}}}
 -- Annotations                                                          {{{
 
 case_tyAnnot :: Assertion
@@ -274,6 +276,29 @@ case_rules = e @=? (proglines sr)
       ]
   sr = "goal += 1 . goal += 2 ."
 
+case_rulesWhitespace :: Assertion
+case_rulesWhitespace = e @=? (proglines sr)
+ where
+  e  = [ LRule (Rule (TFunctor "goal" [] :~ Span (Columns 2 2) (Lines 1 1 16 1) l0)
+                     "+="
+                     []
+                     (TNumeric (Left 1) :~ Span (Lines 1 4 19 4) (Lines 1 6 21 6) l1)
+                    :~ Span (Columns 2 2) (Lines 1 6 21 6) l0)
+                   :~ Span (Columns 2 2) (Lines 1 6 21 6) l0
+       , LRule (Rule (TFunctor "goal" [] :~ Span (Lines 3 1 31 1) (Lines 3 6 36 6) l3)
+                     "+="
+                     []
+                     (TNumeric (Left 2) :~ Span (Lines 3 9 39 9) (Lines 3 11 41 11) l3)
+                    :~ Span (Lines 3 1 31 1) (Lines 3 11 41 11) l3)
+                   :~ Span (Lines 3 1 31 1) (Lines 3 11 41 11) " goal += 2 .\n"
+       ]
+  l0 = "  goal%comment\n"
+  l1 = " += 1 .\n"
+  l2 = "%test \n"
+  l3 = " goal += 2 .\n"
+  sr = B.concat [l0,l1,l2,l3]
+
+
 case_rulesDotExpr :: Assertion
 case_rulesDotExpr = e @=? (proglines sr)
  where