imparse 0.0.0.2 → 0.0.0.3

raw patch · 8 files changed

+232/−175 lines, 8 filesdep +indentsdep +parsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: indents, parsec

API changes (from Hackage documentation)

Files

• Main.hs +8/−11
• Text/Imparse.hs +29/−17
• Text/Imparse/AbstractSyntax.hs +30/−22
• Text/Imparse/Analysis.hs +29/−30
• Text/Imparse/Compile/Haskell.hs +94/−77
• Text/Imparse/Parse.hs +27/−9
• Text/Imparse/Report.hs +8/−6
• imparse.cabal +7/−3

@@ -1,20 +1,17 @@ ----------------------------------------------------------------
 --
--- Imparse
--- Cross-platform/-language parser generator.
---
--- Main.hs
---   Haskell executable wrapper for the Imparse parser parser.
---
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- * Usage:
+-- @Main.hs@
 --
---   imparse "path/file.p"
+--   Main module for the Haskell implementation of the Imparse
+--   parser. Compiled into a Haskell executable wrapper for the
+--   Imparse parser definition parser.
 --
 
 ----------------------------------------------------------------
--- Main module for the Haskell implementation of the
--- Imparse parser.
+--
 
 module Main
   where
@@ -25,7 +22,7 @@ import Text.Imparse (cmd)
 
 ----------------------------------------------------------------
--- The main function.
+-- | The main function.
 
 main :: IO ()
 main =

@@ -1,28 +1,36 @@ ----------------------------------------------------------------
 --
--- Imparse
--- Cross-platform/-language parser generator.
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse.hs
+-- @Text\/Imparse.hs@
+--
 --   Haskell implementation of the Imparse parser parser.
+--   Useful functions for the imparser parser generator.
 --
 
 ----------------------------------------------------------------
--- Useful functions for the imparser parser generator.
+--
 
 module Text.Imparse
   where
 
 import Data.Char (toUpper)
 import Data.List (splitAt, elemIndex)
-import System.Directory (createDirectory, removeDirectoryRecursive, doesDirectoryExist, doesFileExist, removeFile)
+import System.Directory (
+    createDirectory, 
+    removeDirectoryRecursive, 
+    doesDirectoryExist, 
+    doesFileExist, 
+    removeFile
+  )
 import System.Environment (getArgs)
 import System.IO ()
 import Prelude hiding (catch)
 import System.IO.Error hiding (catch)
 import Control.Exception (throwIO, catch)
 
-import qualified Control.Compilation.Compile as C
+import Control.Compilation.String (compiled)
 import qualified Text.UxADT as U (uxadt, javaScriptModule)
 import Text.RichReports (report)
 import Text.Ascetic.HTML (html)
@@ -34,8 +42,8 @@ import Text.Imparse.Compile.Haskell
 
 ----------------------------------------------------------------
--- The target of the output, as specified by the command-line
--- arguments.
+-- | The target of the output, as specified by the command-line
+--   arguments.
 
 type HaskellModulePrefix = String
 
@@ -53,8 +61,8 @@   ot:ots       -> emitHaskell ots
 
 ----------------------------------------------------------------
--- Take a file path in the form of a string, and try to parse
--- the contents of the file into abstract syntax.
+-- | Take a file path in the form of a string, and try to parse
+--   the contents of the file into abstract syntax.
 
 parseShow :: String -> IO ()
 parseShow fname =
@@ -76,8 +84,8 @@      }
 
 ----------------------------------------------------------------
--- Take a file path in the form of a string, read it, and
--- process it as specified by the command line.
+-- | Take a file path in the form of a string, read it, and
+--   process it as specified by the command line.
 
 nothing :: IO ()
 nothing = return ()
@@ -140,10 +148,11 @@                   Nothing  -> do nothing
                   Just pre ->
                     do moduleName <- return $ (\(c:cs) -> toUpper c : cs) fname
-                       writeAndPutStr (fdir ++ "AbstractSyntax") "hs" (C.extract (toAbstractSyntax pre parser) "")
-                       writeAndPutStr (fdir ++ "Report") "hs" (C.extract (toRichReport pre parser) "")
-                       writeAndPutStr (fdir ++ "Parse") "hs" (C.extract (toParsec pre parser) "")
-
+                       putStr $ "  Emitting Haskell implementation of \"" ++ moduleName ++ "\"...\n"
+                       writeAndPutStr (fdir ++ "AbstractSyntax") "hs" (compiled (toAbstractSyntax pre parser))
+                       writeAndPutStr (fdir ++ "Report") "hs" (compiled (toRichReport pre parser))
+                       writeAndPutStr (fdir ++ "Parse") "hs" (compiled (toParsec pre parser))
+                       putStr "\n"
               }
      }
 
@@ -152,7 +161,10 @@      "\nUsage:\n\n"
   ++ "  imparse [optional flags] path/file.p\n\n"
   ++ "Flags:\n\n"
-  ++ ""
+  ++ "   -html\n"
+  ++ "   Emit HTML report containing parser static analysis results.\n\n"
+  ++ "   -hs \"Name.Prefix.For.Modules\"\n"
+  ++ "   Emit Haskell implementations of abstract syntax, parser, and\n   report generator with specified module name prefix.\n\n"
 
 cmd :: [OutputTarget] -> [String] -> IO ()
 cmd [] []            = usage

@@ -1,8 +1,10 @@ ----------------------------------------------------------------
 --
--- Imparse
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse/AbstractSyntax.hs
+-- @Text\/Imparse\/AbstractSyntax.hs@
+--
 --   Data structure for Imparse parser definitions.
 --
 
@@ -12,15 +14,18 @@ module Text.Imparse.AbstractSyntax
   where
 
-import Data.String.Utils (join)
+import Data.Char (isAlpha)
 import Data.List (nub)
+import Data.String.Utils (join)
 
 import qualified Text.RichReports as R
 import qualified Text.UxADT as U
-import qualified StaticAnalysis.All as A
+import qualified StaticAnalysis.Annotate as A
+import qualified StaticAnalysis.Analyze as A
+import qualified StaticAnalysis.Analysis as A
 
 ----------------------------------------------------------------
--- Parser data structure.
+-- | Parser data structure.
 
 type Import = String
 type NonTerminal = String
@@ -76,30 +81,30 @@   deriving Eq
 
 ----------------------------------------------------------------
--- Static analysis annotation setting and retrieval.
+-- | Static analysis annotation setting and retrieval.
 
-instance A.Annotated Parser where
-  annotate (Parser _ ms ps) a = Parser a ms ps
+instance A.Annotate Parser where
+  annotate a (Parser _ ms ps) = Parser a ms ps
   annotation (Parser a ms ps) = a
 
-instance A.Annotated Production where
-  annotate (Production _ e css) a = Production a e css
+instance A.Annotate Production where
+  annotate a (Production _ e css) = Production a e css
   annotation (Production a _ _) = a
 
-instance A.Annotated Choices where
-  annotate (Choices _ cs) a = Choices a cs
+instance A.Annotate Choices where
+  annotate a (Choices _ cs) = Choices a cs
   annotation (Choices a _) = a
 
-instance A.Annotated Choice where
-  annotate (Choice _ mc asc es) a = Choice a mc asc es
+instance A.Annotate Choice where
+  annotate a (Choice _ mc asc es) = Choice a mc asc es
   annotation (Choice a _ _ _) = a
 
-instance A.Annotated Element where
-  annotate e a = case e of
+instance A.Annotate Element where
+  annotate a e = case e of
     NonTerminal _ e -> NonTerminal a e
-    Many e ms       -> Many (A.annotate e a) ms
-    May e           -> May (A.annotate e a)
-    Indented w e    -> Indented w $ A.annotate e a
+    Many e ms       -> Many (A.annotate a e) ms
+    May e           -> May (A.annotate a e)
+    Indented w e    -> Indented w $ A.annotate a e
     _ -> e
   annotation e = case e of
     NonTerminal a _ -> a
@@ -109,8 +114,11 @@     _               -> A.unanalyzed
 
 ----------------------------------------------------------------
--- Functions for inspecting parser instances.
+-- | Functions for inspecting parser instances.
 
+isOp :: String -> Bool
+isOp s = not (s `elem` ["(",")","[","]","{","}"]) && not (and (map isAlpha s))
+
 isData :: Element a -> Bool
 isData e = case e of
   NonTerminal _ _         -> True
@@ -135,7 +143,7 @@ productionNonTerminal (Production _ nt _) = nt
 
 ----------------------------------------------------------------
--- Functions for converting a parser into a UXADT instance string.
+-- | Functions for converting a parser into a UXADT instance string.
 
 instance U.ToUxADT (Parser a) where
   uxadt (p@(Parser _ _ ps)) = 
@@ -174,7 +182,7 @@     RegExp r        -> U.C "RegExp" [U.S r]
 
 ----------------------------------------------------------------
--- Functions for converting a parser into an ASCII string.
+-- | Functions for converting a parser into an ASCII string.
 
 instance Show (Parser a) where
   show (Parser _ _ ps) = join "\n\n" (map show ps) ++ "\n"

@@ -1,13 +1,15 @@ ----------------------------------------------------------------
 --
--- Imparse
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse/Analysis.hs
+-- @Text\/Imparse\/Analysis.hs@
+--
 --   Analyzer/validator for Imparse parsers.
 --
 
 ----------------------------------------------------------------
--- 
+--
 
 module Text.Imparse.Analysis
   where
@@ -23,8 +25,8 @@ import Text.Imparse.Report
 
 ----------------------------------------------------------------
--- Analysis data structure, instance declarations, accessors,
--- and mutators.
+-- | Analysis data structure, instance declarations, accessors,
+--   and mutators.
 
 type InitialNonTerminals = [A.NonTerminal]
 type InitialTerminals = [A.Terminal]
@@ -59,7 +61,6 @@   | ChoiceRecursive
   | ChoiceRecursivePrefix
   | ChoiceRecursiveInfix
-  | ChoiceIndentedSuffix
   | ChoiceConstructorDuplicate
   | NonTerminalUnbound
   deriving (Eq, Show)
@@ -71,19 +72,19 @@ tag a ts' = case a of 
   Analyzed ts c -> Analyzed (nub $ ts' ++ ts) c
 
-tags :: S.Annotated a => a Analysis -> [Tag]
+tags :: S.Annotate a => a Analysis -> [Tag]
 tags d = let Analyzed ts _ = S.annotation d in ts
 
-initialTerminals :: S.Annotated a => a Analysis -> InitialTerminals
+initialTerminals :: S.Annotate a => a Analysis -> InitialTerminals
 initialTerminals d = let Analyzed _ (ts, _, _) = S.annotation d in ts
 
-initialNonTerminals :: S.Annotated a => a Analysis -> InitialNonTerminals
+initialNonTerminals :: S.Annotate a => a Analysis -> InitialNonTerminals
 initialNonTerminals d = let Analyzed _ (_, ns, _) = S.annotation d in ns
 
-reachable :: S.Annotated a => a Analysis -> ReachableNonTerminals
+reachable :: S.Annotate a => a Analysis -> ReachableNonTerminals
 reachable d = let Analyzed _ (_, _, rns) = S.annotation d in rns
 
-characterization :: S.Annotated a => a Analysis -> Characterization
+characterization :: S.Annotate a => a Analysis -> Characterization
 characterization d = let Analyzed _ c = S.annotation d in c
 
 combine :: [Characterization] -> Characterization
@@ -93,7 +94,7 @@ mapCmb f xs = let (xs', cs) = unzip $ map f xs in (xs', combine cs)
 
 ----------------------------------------------------------------
--- Reporting of analysis results.
+-- | Reporting of analysis results.
 
 instance R.ToMessages Analysis where
   messages a = case a of
@@ -131,7 +132,6 @@     ChoiceRecursive             -> [R.Text "Recursive"]
     ChoiceRecursivePrefix       -> [R.Text "RecursivePrefix"]
     ChoiceRecursiveInfix        -> [R.Text "RecursiveInfix"]
-    ChoiceIndentedSuffix        -> [R.Text "IndentedSuffix"]
     ChoiceConstructorDuplicate  -> [R.Text "ConstructorDuplicate"]
     NonTerminalUnbound          -> [R.Text "Unbound"]
     _ -> []
@@ -145,9 +145,9 @@     _ -> []
 
 ----------------------------------------------------------------
--- Baseline analysis (initial non-/terminals and reachable
--- non-terminals) and its closure (fully recursive
--- characterization of initial and reachable non-/terminals).
+-- | Baseline analysis (initial non-/terminals and reachable
+--   non-terminals) and its closure (fully recursive
+--   characterization of initial and reachable non-/terminals).
 
 baseline :: A.Parser Analysis -> A.Parser Analysis
 baseline (A.Parser a ims ps) = A.Parser (Analyzed [] r) ims ps' where
@@ -221,7 +221,7 @@   lookP e' (A.Production (Analyzed _ c) e _) = if e == e' then [c] else []
 
 ----------------------------------------------------------------
--- Property derivation and tagging algorithms.
+-- | Property derivation and tagging algorithms.
 
 tagging :: A.Parser Analysis -> A.Parser Analysis
 tagging (A.Parser a ims ps) = A.Parser a ims (map production ps) where
@@ -264,18 +264,6 @@                  if nt1 == e && nt2 == e && isJust mc then [ChoiceRecursiveInfix] else []
                _ -> []
             )
-         ++ (let chkTerm e = case e of A.Terminal _ -> True ; _ -> False
-                 chkNotIndented e = case e of A.Indented _ _ -> False ; _ -> True
-                 chkLast e = case e of A.Indented True (A.Many _ _) -> True ; _ -> False
-             in if  ( length es > 1 
-                   && and (map chkNotIndented (init es))
-                   && or (map chkTerm (init es))
-                   && chkLast (last es)
-                    ) then
-                    [ChoiceIndentedSuffix] 
-                  else 
-                    []
-            )
 
 analyze :: A.Parser Analysis -> A.Parser Analysis
 analyze parser =
@@ -328,7 +316,7 @@     in A.Parser a ims ps'''
 
 ----------------------------------------------------------------
--- Other useful functions.
+-- | Other useful functions.
 
 infixPrefixOps :: A.Parser Analysis -> [String]
 infixPrefixOps (A.Parser _ _ ps) = 
@@ -345,5 +333,16 @@          c@(A.Choice _ _ _ [A.NonTerminal _ nt1, A.Terminal (A.Explicit op), A.NonTerminal _ nt2]) <- cs,
          ChoiceRecursiveInfix `elem` tags c
        ]
+
+allOps :: A.Parser Analysis -> [String]
+allOps (p@(A.Parser _ _ ps)) = 
+  nub $ infixPrefixOps p
+    ++  [s | 
+          A.Production _ _ css <- ps, 
+          A.Choices _ cs <- css, 
+          A.Choice _ _ _ es <- cs,
+          A.Terminal (A.Explicit s) <- es,
+          A.isOp s
+        ]
 
 --eof

@@ -1,8 +1,10 @@ ----------------------------------------------------------------
 --
--- Imparse
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse/Compile/Haskell.hs
+-- @Text\/Imparse\/Compile\/Haskell.hs@
+--
 --   Compilation from an Imparse parser definition to a Haskell
 --   implementation of a abstract syntax data type and Parsec
 --   parser.
@@ -14,29 +16,48 @@ module Text.Imparse.Compile.Haskell
   where
 
-import Data.Char (toLower)
+import Data.Char (isAlphaNum, toLower)
 import Data.List (nub, (\\))
 import Data.String.Utils (join, replace)
 import Data.Maybe (catMaybes)
-import Control.Compilation.Compile
+import Control.Compilation (Compile, StateExtension(..), nothing)
+import Control.Compilation.String
+import Control.Compilation.Fresh
 
 import Text.Imparse.AbstractSyntax
 import qualified Text.Imparse.Analysis as S
 
 ----------------------------------------------------------------
--- Helper functions.
+-- | State data structure
 
+data State =
+  State StateExtensionFresh StateExtensionString
+
+instance StateExtension State where
+  initial = State initial initial
+
+instance HasFresh State where
+  project (State i s) = i
+  inject i (State _ s) = State i s
+
+instance HasString State where
+  project (State i s) = s
+  inject s (State i _) = State i s
+
+----------------------------------------------------------------
+-- | Helper functions.
+
 toLowerFirst :: String -> String
 toLowerFirst []     = []
 toLowerFirst (c:cs) = toLower c : cs
 
 ----------------------------------------------------------------
--- Compilation to abstract syntax data type definition.
+-- | Compilation to abstract syntax data type definition.
 
-toAbstractSyntax :: String -> Parser a -> Compile String ()
+toAbstractSyntax :: String -> Parser a -> Compile State ()
 toAbstractSyntax prefix p =
   do prefix <- return $ if prefix == "" then "" else prefix ++ "."
-     raw $ "-- This module generated automatically by imparse.\n\n"
+     raw $ "-- This module was generated automatically by imparse.\n\n"
      raw $ "module " ++ prefix ++ "AbstractSyntax\n"
      raw "  where"
      newlines 2
@@ -44,9 +65,9 @@      newline
      raw "--eof"
 
-toDatatype :: Parser a -> Compile String ()
+toDatatype :: Parser a -> Compile State ()
 toDatatype (Parser _ _ ps) =
-  let production :: Production a -> Compile String ()
+  let production :: Production a -> Compile State ()
       production (Production _ e css) =
         do raw "data "
            raw e
@@ -59,7 +80,7 @@            unindent
            newlines 2
 
-      choices :: [Choice a] -> Compile String ()
+      choices :: [Choice a] -> Compile State ()
       choices cs = case cs of
         [c]  -> 
           do choice c
@@ -70,7 +91,7 @@              raw "| "
              choices cs
 
-      choice :: Choice a -> Compile String ()
+      choice :: Choice a -> Compile State ()
       choice c = case c of
         Choice _ con _ es -> 
           do con <-
@@ -81,7 +102,7 @@              mapM element es
              nothing
 
-      element :: Element a -> Compile String ()
+      element :: Element a -> Compile State ()
       element e = case e of
         NonTerminal _ entity -> do { raw " "; raw entity }
         Many e _             -> do { raw " ["; elementNoSp e; raw "]" }
@@ -91,7 +112,7 @@         Terminal t           -> do { raw " "; terminal t }
         _                    -> do nothing
 
-      elementNoSp :: Element a -> Compile String ()
+      elementNoSp :: Element a -> Compile State ()
       elementNoSp e = case e of
         NonTerminal _ entity -> do { raw entity }
         Many e  _            -> do { raw "["; element e; raw "]" }
@@ -99,7 +120,7 @@         May e                -> do { raw "(Maybe "; elementNoSp e; raw ")" }
         _                    -> element e
 
-      terminal :: Terminal -> Compile String ()
+      terminal :: Terminal -> Compile State ()
       terminal t = case t of
         StringLiteral  -> raw "String"
         NaturalLiteral -> raw "Integer"
@@ -114,11 +135,11 @@         nothing
 
 ----------------------------------------------------------------
--- Compilation to rich reporting instance declarations.
+-- | Compilation to rich reporting instance declarations.
 
-toRichReport :: String -> Parser a -> Compile String ()
+toRichReport :: String -> Parser a -> Compile State ()
 toRichReport prefix p =
-  do raw $ "-- This module generated automatically by imparse.\n\n"
+  do raw $ "-- This module was generated automatically by imparse.\n\n"
      prefix <- return $ if prefix == "" then "" else prefix ++ "."
      raw $ "module " ++ prefix ++ "Report"
      newline
@@ -132,9 +153,9 @@      newline
      raw "--eof"
 
-toReportFuns :: Parser a -> Compile String ()
+toReportFuns :: Parser a -> Compile State ()
 toReportFuns (Parser _ _ ps) =
-  let production :: Production a -> Compile String ()
+  let production :: Production a -> Compile State ()
       production (Production _ e css) =
         do raw $ "instance R.ToReport " ++ e ++ " where"
            indent
@@ -147,12 +168,12 @@            unindent
            newline
 
-      choices :: Choices a -> Compile String ()
+      choices :: Choices a -> Compile State ()
       choices (Choices a cs) = case cs of
         []   -> do nothing
         c:cs -> do { choice c; newline; choices (Choices a cs) }
 
-      choice :: Choice a -> Compile String ()
+      choice :: Choice a -> Compile State ()
       choice c = case c of
         Choice _ con _ es -> 
           do con <-
@@ -193,24 +214,24 @@         nothing
 
 ----------------------------------------------------------------
--- Compilation to Parsec parser.
+-- | Compilation to Parsec parser.
 
-toParsec :: String -> Parser S.Analysis -> Compile String ()
+toParsec :: String -> Parser S.Analysis -> Compile State ()
 toParsec prefix (p@(Parser _ _ ((Production _ eRoot _):_))) =
-  do raw $ "-- This module generated automatically by imparse.\n\n"
+  do raw $ "-- This module was generated automatically by imparse.\n\n"
      prefix <- return $ if prefix == "" then "" else prefix ++ "."
      raw $ "module " ++ prefix ++ "Parse\n  where\n"
      newline
      raw $ "import " ++ prefix ++ "AbstractSyntax"
      newlines 2
 
-     reservedOpNames <- return $ nub $ S.infixPrefixOps p
-     opLetters <- return $ nub $ concat reservedOpNames
+     reservedOpNames <- return $ nub $ S.allOps p
+     opLetters <- return $ nub $ [c | c <- concat reservedOpNames, not $ isAlphaNum c]
      reservedNames <- return $ (nub [r | Explicit r <- terminals p]) \\ reservedOpNames
 
      raw "----------------------------------------------------------------\n-- Parser to convert concrete syntax to abstract syntax.\n\n"
      raw "import Text.Parsec\n"
-     raw "import qualified Text.Parsec.Indent as PI (withBlock, runIndent)\n"
+     raw "import qualified Text.Parsec.Indent as PI (runIndent, checkIndent, withPos, indented, block)\n"
      raw "import qualified Text.Parsec.Token as PT\n"
      raw "import qualified Text.Parsec.Expr as PE\n"
      raw "import qualified Text.ParserCombinators.Parsec.Language as PL\n"
@@ -226,30 +247,37 @@      raw "----------------------------------------------------------------\n-- Parsec-specific configuration definitions and synonyms.\n\n"
      raw "langDef :: PL.GenLanguageDef String () ParseState\n"
      raw "langDef = PL.javaStyle\n"
-     raw "  { PL.identStart        = oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijkmlnopqrstuvwxyz_\" -- Only lowercase.\n"
-     raw "  , PL.identLetter       = alphaNum <|> oneOf \"_'\"\n"
-     raw "  , PL.opStart           = PL.opLetter langDef\n"
+     raw $ "  { PL.identStart        = oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijkmlnopqrstuvwxyz_\" -- Only lowercase.\n"
+     raw $ "  , PL.identLetter       = alphaNum <|> oneOf \"_'\"\n"
+     raw $ "  , PL.opStart           = PL.opLetter langDef\n"
      raw $ "  , PL.opLetter          = oneOf \"" ++ opLetters ++ "\"\n"
      raw $ "  , PL.reservedOpNames   = [" ++ join "," ["\"" ++ rO ++ "\"" | rO <- reservedOpNames] ++ "]\n"
      raw $ "  , PL.reservedNames     = [" ++ join "," ["\"" ++ rO ++ "\"" | rO <- reservedNames] ++ "]\n"
-     raw "  , PL.commentLine       = \"#\"\n"
-     raw "  }\n\n"
+     raw $ "  , PL.commentLine       = \"#\"\n"
+     raw "  }"
+     newlines 2
      raw "lang :: PT.GenTokenParser [Char] () ParseState\n"
-     raw "lang = PT.makeTokenParser langDef\n\n"
+     raw "lang = PT.makeTokenParser langDef"
+     newlines 2
      raw "whiteSpace = PT.whiteSpace lang\n"
      raw "symbol     = PT.symbol lang\n"
      raw "rO         = PT.reservedOp lang\n"
      raw "res        = PT.reserved lang\n"
      raw "identifier = PT.identifier lang\n"
-     raw "natural    = PT.natural lang\n\n"
+     raw "natural    = PT.natural lang"
+     newlines 2
      raw "binary name f assoc = PE.Infix (do{PT.reservedOp lang name; return f}) assoc\n"
-     raw "prefix name f       = PE.Prefix (do{PT.reservedOp lang name; return f})\n\n"
-     raw "withIndent p1 p2 f = PI.withBlock f p1 p2\n\n"
+     raw "prefix name f       = PE.Prefix (do{PT.reservedOp lang name; return f})"
+     newlines 2
      raw "con :: ParseFor String\n"
-     raw "con = do { c <- oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\" ; cs <- option \"\" identifier ; return $ c:cs }\n\n"
+     raw "con = do { c <- oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\" ; cs <- option \"\" identifier ; return $ c:cs }"
+     newlines 2
      raw "flag :: ParseFor String\n"
      raw "flag = do { cs <- many1 (oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\") ; return cs }\n"
-     raw "-- caps = do { cs <- many1 (oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\") ; return cs }\n\n"
+     raw "-- caps = do { cs <- many1 (oneOf \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\") ; return cs }"
+     newlines 2
+     raw "block0 p = PI.withPos $ do { r <- many (PI.checkIndent >> p); return r }\n"
+     raw "may p = option Nothing (do {x <- p; return $ Just x})\n"
      raw "(<?|>) p1 p2 = (try p1) <|> p2\n\n"
      raw "----------------------------------------------------------------\n-- Parser definition.\n\n"
      raw $ "root = do { whiteSpace ; r <- p" ++ eRoot ++ " ; eof ; return r }"
@@ -257,9 +285,12 @@      toParsecDefs p
      raw "--eof"
 
-toParsecDefs :: Parser S.Analysis -> Compile String ()
+toParsecDefs :: Parser S.Analysis -> Compile State ()
 toParsecDefs (Parser _ _ ps) =
-  let production :: Production S.Analysis -> Compile String ()
+  let explicitCmb :: String -> String
+      explicitCmb s = if isOp s then "rO" else "res" 
+
+      production :: Production S.Analysis -> Compile State ()
       production (p@(Production _ e css)) =
         do raw $ "p" ++ e ++ " ="
            ( if S.ProductionInfixPrefixThenDeterministic `elem` S.tags p then
@@ -289,7 +320,7 @@              else
                do indent
                   ( if ((length css > 1) || (or [length cs > 1 | Choices _ cs <- css])) then
-                      do { newline ; raw "    " }
+                      do { newline ; raw "     " }
                     else
                       raw " "
                     )
@@ -298,7 +329,7 @@                   newline
              )
 
-      choices :: [Choice S.Analysis] -> Compile String ()
+      choices :: [Choice S.Analysis] -> Compile State ()
       choices cs = case cs of
         [c]  -> 
           do choice c
@@ -307,27 +338,11 @@         c:cs ->
           do choice c 
              newline
-             raw "<|> "
+             raw "<?|> "
              choices cs
 
-      choice :: Choice S.Analysis -> Compile String ()
+      choice :: Choice S.Analysis -> Compile State ()
       choice (c@(Choice _ con _ es)) =
-        if S.ChoiceIndentedSuffix `elem` S.tags c then
-          do ves <- return $ init [("v" ++ show k, es!!k) | k <- [0..length es-1]]
-             con <-
-                case con of
-                   Nothing  -> do { c <- fresh; return $ "C" ++ c }
-                   Just con -> return con
-             nt <- return $ (\(Indented w (Many (NonTerminal _ nt) _)) -> nt) $ last es
-             raw $ "withIndent ("
-             raw "do {"
-             raw $ join "; " (map element ves)
-             raw "; "
-             raw $ "return $ (" ++ join ", " (catMaybes (map arg ves)) ++ ")"
-             raw "}) "
-             raw $ "p" ++ nt
-             raw $ " (\\(" ++ (join ", " $ catMaybes (map arg ves)) ++ ") vs -> " ++ con ++ " " ++ join " " (catMaybes (map arg ves)) ++ " vs)"
-        else
           do ves <- return $ [("v" ++ show k, es!!k) | k <- [0..length es-1]]
              con <-
                 case con of
@@ -340,21 +355,23 @@              raw "}"
 
       element :: (String, Element S.Analysis) -> String
-      element (v, e) = case e of
-        NonTerminal _ nt            -> v ++ " <- p" ++ nt
-        May (Many (NonTerminal _ nt) sep) ->
-          let comb = maybe "many" (\_ -> "sepBy") sep
-              suffix = maybe "" (\sep -> " (res \"" ++ sep ++ "\")") sep
-          in v ++ " <- " ++ comb ++ " p" ++ nt ++ suffix
-        Many (NonTerminal _ nt) sep ->
-          let comb = maybe "many" (\_ -> "sepBy") sep
-              suffix = maybe "" (\sep -> " (res \"" ++ sep ++ "\")") sep
-          in v ++ " <- " ++ comb ++ "1" ++ " p" ++ nt ++ suffix
-        May (NonTerminal _ nt)      -> v ++ " <- option p" ++ nt
-        Indented False e'           -> element (v, e')
-        Indented True e'            -> ""
-        Terminal t                  -> terminal v t
-        _                           -> ""
+      element (v, e) = 
+        let mkP e = case e of
+              NonTerminal _ nt         -> "p" ++ nt
+              Many e' Nothing          -> "(many1 (" ++ mkP e' ++ "))"
+              Many e' (Just sep)       -> "(sepBy1 " ++ mkP e' ++ " (" ++ explicitCmb sep ++ " \"" ++ sep ++ "\"))"
+              May (Many e' Nothing)    -> "(many (" ++ mkP e' ++ "))"
+              May (Many e' (Just sep)) -> "(sepBy " ++ mkP e' ++ " (" ++ explicitCmb sep ++ " \"" ++ sep ++ "\"))"
+              May e'                   -> "(may (" ++ mkP e' ++ "))"
+              Indented False e'        -> mkP e'
+              Indented True e' ->
+                case e' of
+                  Many e' Nothing       -> "(PI.indented >> PI.block (" ++ mkP e' ++ "))"
+                  May (Many e' Nothing) -> "(PI.indented >> block0 (" ++ mkP e' ++ "))"
+              _                        -> ""
+        in case e of
+          Terminal t -> terminal v t
+          _ -> case mkP e of "" -> "" ; p -> v ++ " <- " ++ p
 
       arg :: (String, Element S.Analysis) -> Maybe String
       arg (v, e) = case e of
@@ -378,7 +395,6 @@ 
       terminal :: String -> Terminal -> String
       terminal v t = case t of
-        Explicit s     -> "res \"" ++ s ++ "\""
         StringLiteral  -> v ++ " <- literal"
         NaturalLiteral -> v ++ " <- natural"
         DecimalLiteral -> v ++ " <- decimal"
@@ -386,6 +402,7 @@         Constructor    -> v ++ " <- con"
         Flag           -> v ++ " <- flag"
         RegExp r       -> "regexp"
+        Explicit s     -> explicitCmb s ++ " \"" ++ s ++ "\""
 
   in do mapM production ps
         nothing

@@ -1,20 +1,22 @@ ----------------------------------------------------------------
 --
--- Imparse
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse/Parse.hs
+-- @Text\/Imparse\/Parse.hs@
+--
 --   Parser for Imparse parser specification concrete syntax.
 --
 
 ----------------------------------------------------------------
--- 
+--
 
 module Text.Imparse.Parse (parseParser)
   where
 
 import Data.Char (isAlpha, isAlphaNum)
 import Data.Maybe (catMaybes)
-import Data.List (isPrefixOf, findIndex)
+import Data.List (nub, findIndex, isPrefixOf)
 import Data.List.Split (splitOn, splitWhen)
 import Data.Text (unpack, strip, pack)
 
@@ -23,7 +25,7 @@ import Text.Imparse.AbstractSyntax
 
 ----------------------------------------------------------------
--- Exported functions.
+-- | Exported functions.
 
 parseParser :: A.Analysis a => String -> Either String (Parser a)
 parseParser s = 
@@ -31,12 +33,12 @@   in Right $ Parser A.unanalyzed [] $ catMaybes [pProductionOrDelimiters (trim b) | b <- blocks]
 
 ----------------------------------------------------------------
--- Parsing functions.
+-- | Parsing functions.
 
 pProductionOrDelimiters :: A.Analysis a => String -> Maybe (Production a)
-pProductionOrDelimiters s = case splitOn "\n" s of
+pProductionOrDelimiters s = case splitOn "\n" (noEmptyLines s) of
   line:lines -> 
-    case splitOn " " line of
+    case nonemp $ splitOn " " line of
       [entity, "::="] -> 
         Just $ 
           Production A.unanalyzed entity $
@@ -48,7 +50,7 @@   _ -> Nothing
 
 pChoice :: A.Analysis a => String -> Maybe (Choice a)
-pChoice s = case filter ((/=) "") $ splitOn " " (trim s) of
+pChoice s = case nonemp $ splitOn " " (trim s) of
   "|":es   -> Just $ Choice A.unanalyzed Nothing AssocNone [pElement e | e <- es, e /= ""]
   "<":es   -> Just $ Choice A.unanalyzed Nothing AssocLeft [pElement e | e <- es, e /= ""]
   ">":es   -> Just $ Choice A.unanalyzed Nothing AssocRight [pElement e | e <- es, e /= ""]
@@ -101,10 +103,26 @@ ----------------------------------------------------------------
 -- Helpful auxiliary functions.
 
+nonemp :: [String] -> [String]
+nonemp = filter ((/=) "")
+
 trim :: String -> String
 trim = unpack.strip.pack
 
 ends :: String -> String -> String -> Bool
 ends p s t = isPrefixOf p t && isPrefixOf (reverse s) (reverse t)
+
+noEmptyLines :: String -> String
+noEmptyLines s = case s of
+  '\n':s' ->
+    case findIndex (=='\n') s' of
+      Nothing -> s
+      Just i  -> 
+        if nub (take i s') == [' '] then
+          "\n\n" ++ noEmptyLines (drop (i+1) s')
+        else
+          "\n" ++ (noEmptyLines s')
+  c   :s' -> c : noEmptyLines s'
+  ""      -> ""
 
 --eof

@@ -1,13 +1,15 @@ ----------------------------------------------------------------
 --
--- Imparse
+-- | Imparse
+--   Cross-platform and -language parser generator.
 --
--- Text/Imparse/Report.hs
+-- @Text\/Imparse\/Report.hs@
+--
 --   Generation of rich reports from parser definitions.
 --
 
 ----------------------------------------------------------------
--- 
+--
 
 module Text.Imparse.Report
   where
@@ -20,8 +22,8 @@ import Text.Imparse.AbstractSyntax
 
 ----------------------------------------------------------------
--- Functions for converting a parser abstract syntax instance
--- into a rich report.
+-- | Functions for converting a parser abstract syntax instance
+--   into a rich report.
 
 instance (R.ToHighlights a, R.ToMessages a) => R.ToReport (Parser a) where
   report (Parser _ _ ps) = R.Finalize $ R.Conc [R.report p | p <- ps]
@@ -81,7 +83,7 @@     StringLiteral  -> R.key "`$"
     NaturalLiteral -> R.key "`#"
     DecimalLiteral -> R.key "`#.#"
-    Identifier     -> R.key "`id"
+    Identifier     -> R.key "`var"
     Constructor    -> R.key "`con"
     Flag           -> R.key "`flag"
     RegExp r       -> R.Span [] [] [R.key "`{", R.Text r, R.key "}"]

@@ -1,5 +1,5 @@ Name:              imparse
-Version:           0.0.0.2
+Version:           0.0.0.3
 Cabal-Version:     >= 1.6
 License:           GPL-3
 License-File:      LICENSE
@@ -27,7 +27,9 @@                    compilation,
                    ascetic,
                    uxadt,
-                   richreports
+                   richreports,
+                   parsec,
+                   indents
 
 Executable imparse
   Main-Is:         Main.hs
@@ -41,7 +43,9 @@                    compilation,
                    ascetic,
                    uxadt,
-                   richreports
+                   richreports,
+                   parsec,
+                   indents
 
 Source-Repository head
   Type:            git