packages feed

indentation-parsec (empty) → 0.0

raw patch · 11 files changed

+975/−0 lines, 11 filesdep +basedep +indentation-coredep +indentation-parsecsetup-changed

Dependencies added: base, indentation-core, indentation-parsec, mtl, parsec, tasty, tasty-hunit

Files

+ CHANGELOG.md view
@@ -0,0 +1,4 @@+# 0.0++* Split `indentation` into separate `indentation-core`, `indentation-parsec` and `indentation-trifecta` packages.+  Keep the original `indentation` for backward compatability and as a general roll-up package.
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014, Michael D. Adams+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+may be used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ indentation-parsec.cabal view
@@ -0,0 +1,70 @@+name:                indentation-parsec+version:             0.0+synopsis:            Indentation sensitive parsing combinators for Parsec+description:         Indentation sensitive parsing combinators for Parsec+                     .                     +                     See+                     .+                         __Michael D. Adams and Ömer S. Ağacan__.+                         Indentation-sensitive parsing for Parsec.+                         In /Proceedings of the 2014 ACM SIGPLAN Symposium on Haskell/,+                         Haskell ’14, pages 121–132.+                         ACM, New York, NY, USA, September 2014. ISBN 978-1-4503-3041-1.+                         <http://dx.doi.org/10.1145/2633357.2633369 doi:10.1145/2633357.2633369>.+                     .+                     This package provides indentation combinators for+                     Parsec.  For Trifecta, install+                     indentation-trifecta.  For backward compatability+                     or to install both, install indentation.+++license:             BSD3+license-file:        LICENSE+author:              Michael D. Adams <http://michaeldadams.org/>+maintainer:          Ömer Sinan Ağacan <omeragacan@gmail.com>+                     Aleksey Kliger <aleksey@lambdageek.org>+category:            Parsing+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:  CHANGELOG.md+                     src/Text/Parsec/Indentation/Examples/*.hs++homepage:            https://bitbucket.org/adamsmd/indentation+bug-reports:         https://bitbucket.org/adamsmd/indentation/issues+tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1++source-repository head+  type:                git+  location:            https://bitbucket.org/adamsmd/indentation.git++library+  hs-source-dirs:      src+  build-depends:       base >=4.6 && <4.10,+                       mtl >=2.1,+                       indentation-core == 0.0,+                       parsec >=3.1.5+  exposed-modules:     Text.Parsec.Indentation+                     , Text.Parsec.Indentation.Char+                     , Text.Parsec.Indentation.Token++  default-language:    Haskell2010++  ghc-options:         -Wall++test-suite test-indentation+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:          all-tests.hs+  build-depends:+      parsec+  other-modules:+      ParensParsec+  build-depends:+      base >= 4 && < 5+    , tasty >= 0.10+    , tasty-hunit >= 0.9+    , indentation-parsec
+ src/Text/Parsec/Indentation.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, TupleSections #-}+{-# OPTIONS -Wall  #-}+module Text.Parsec.Indentation (module Text.Parsec.Indentation, I.IndentationRel(..), Indentation, infIndentation) where++-- Implements "Indentation Senstivie Parising: Landin Revisited"+--+-- Primary functions are:+--  - 'localIndent':+--  - 'absoluteIndent':+--  - 'localTokenMode':+--+-- Primary driver functions are:+--  - TODO++-- TODO:+--   Grace style indentation stream++import Control.Monad+--import Text.Parsec.Prim+import Text.Parsec.Prim (ParsecT, mkPT, runParsecT,+                         Stream(..), Consumed(..), Reply(..),+                         State(..), getInput, setInput)+import Text.Parsec.Error (Message (Message), addErrorMessage)+import Text.Parser.Indentation.Implementation as I++------------------------+-- Indentable Stream+------------------------++data IndentStream s = IndentStream { indentationState :: !IndentationState, tokenStream :: !s } deriving (Show)+--data IndentationToken t = IndentationToken !t | InvalidIndentation String+type IndentationToken t = t++{-# INLINE mkIndentStream #-}+mkIndentStream :: Indentation -> Indentation -> Bool -> IndentationRel -> s -> IndentStream s+mkIndentStream lo hi mode rel s = IndentStream (mkIndentationState lo hi mode rel) s++instance (Monad m, Stream s m (t, Indentation)) => Stream (IndentStream s) m (IndentationToken t) where+  uncons (IndentStream is s) = do+    x <- uncons s+    case x of+      Nothing -> return Nothing+      Just ((t, i), s') -> return $ updateIndentation is i ok err where+        ok is' = Just ({-IndentationToken-} t, IndentStream is' s')+        err _ = Nothing --(InvalidIndentation msg, IndentStream is s)+        -- HACK: Sigh! We have no way to properly signal the+        -- sort of failure that occurs here.  We would do 'fail+        -- "Invalid indentation.  "++msg', but that triggers a+        -- non-backtracking error.  'return Nothing' will make+        -- Parsec think the stream is empty (which is wrong),+        -- but at least it is a backtracking error.  The+        -- fundamental problem is that 'm' *not* ParsecT (where+        -- we could signal a parsing error) but is whatever+        -- monad 'm' happens to be the argument to ParsecT.++{-# INLINE localState #-}+localState :: (Monad m) => LocalState (ParsecT (IndentStream s) u m a)+localState pre post m = do+  IndentStream is s <- getInput+  setInput (IndentStream (pre is) s)+  x <- m+  IndentStream is' s' <- getInput+  setInput (IndentStream (post is is') s')+  return x++{-# INLINE localStateUnlessAbsMode #-}+localStateUnlessAbsMode :: (Monad m) => LocalState (ParsecT (IndentStream s) u m a)+localStateUnlessAbsMode pre post m = do+  a <- liftM (indentationStateAbsMode . indentationState) getInput+  if a then m else localState pre post m+++------------------------+-- Operations+------------------------++{-# INLINE localTokenMode #-}+localTokenMode :: (Monad m) => (IndentationRel -> IndentationRel) -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+localTokenMode = I.localTokenMode localState++{-# INLINE localIndentation #-}+localIndentation :: (Monad m) => IndentationRel -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+localIndentation = I.localIndentation localStateUnlessAbsMode++{-# INLINE absoluteIndentation #-}+absoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+absoluteIndentation = I.absoluteIndentation localState+--  post _  i2 = when (absMode i2) (fail "absoluteIndent: no tokens consumed") >>++{-# INLINE ignoreAbsoluteIndentation #-}+ignoreAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+ignoreAbsoluteIndentation = I.ignoreAbsoluteIndentation localState++{-# INLINE localAbsoluteIndentation #-}+localAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+localAbsoluteIndentation = I.localAbsoluteIndentation localState++------------------------+-- Indent Stream Impls+------------------------++streamToList :: (Monad m, Stream s m t) => s -> m [t]+streamToList s = do+  x <- uncons s+  case x of+    Nothing -> return []+    Just (c, s') -> do s'' <- streamToList s'+                       return (c : s'')++----------------+-- SourcePos++{-+mkSourcePosIndentStream s = SourcePosIndentStream s+newtype SourcePosIndentStream s = SourcePosIndentStream s+instance (Stream s m t) => Stream (SourcePosIndentStream s) m (Indent, t) where+  uncons (SourcePosIndentStream s) = do+    col <- liftM sourceColumn $ getPosition+    x <- uncons s+    case x of+      Nothing -> return Nothing+      Just x -> return (Just ((col, x), SourcePosIndentStream s))+-}+++----------------+-- TODO: parser based on first non-whitespace char++----------------+-- First token of line indents++----------------+-- Based on Indents++-- Note that if 'p' consumes input but is at the wrong indentation, then+-- 'indentStreamParser p' signals an error but does *not* consume input.+-- This allows Parsec primitives like 'string' to be properly backtracked.+{-# INLINE indentStreamParser #-}+indentStreamParser :: (Monad m) => ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m (IndentationToken t)+indentStreamParser p = mkPT $ \state ->+  let IndentStream is s = stateInput state+      go f (Ok (a, i) state' e) = updateIndentation is i ok err where+        ok is' = return $ f $ return (Ok ({-IndentationToken-} a) (state' {stateInput = IndentStream is' (stateInput state') }) e)+        err msg = return $ Empty $ return $ Error (Message ("Invalid indentation.  "++msg++show ((stateInput state) { tokenStream = ""})) `addErrorMessage` e)+      go f (Error e) = return $ f $ return (Error e)+  in runParsecT p (state { stateInput = s }) >>= consumed (go Consumed) (go Empty)++{-# INLINE consumed #-}+consumed :: (Monad m) => (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b+consumed c _ (Consumed m) = m >>= c+consumed _ e (Empty m)    = m >>= e++-- lifting operator+-- token, tokens, tokenPrim, tokenPrimEx ???+-- whiteSpace+-- ByteString+-- ByteString.Lazy+-- Text++{-+delimitedLayout :: Stream (IndentStream s) m t =>+  ParsecT (IndentStream s) u m open -> Bool ->+  ParsecT (IndentStream s) u m close -> Bool ->+  ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a+delimitedLayout open openAny close closeAny body = between open' close' (localIndent (Const 0) body) where+  open'  | openAny = localIndent (Const 0) open+         | otherwise = open+  close' | closeAny = localIndent (Const 0) close+         | otherwise = close++indentedLayout :: Stream (IndentStream s) m t =>+  (Maybe (ParsecT (IndentStream s) u m sep)) ->+  ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]+indentedLayout (Nothing ) clause = localIndent Gt $ many $ absoluteIndent $ clause+indentedLayout (Just sep) clause = liftM concat $ localIndent Gt $ many $ absoluteIndent $ sepBy1 clause sep+-}++{-+layout p = delimitedLayout (symbol "{") False (symbol "}") True (semiSep p)+       <|> indentedLayout (Just semi) p++identifier pred = liftM fromString $ try $ identifier >>= \x -> guard (pred x) >> return x+operator pred = liftM fromString $ try $ operator >>= \x -> guard (pred x) >> return x++reserved name = (if name `elem` middleKeywords then localFirstTokenMode (const Ge) else id) $ reserved name++Numbers, Integers and Naturals are custom++dotSep+dotSep1++-}++{-+test :: String+test = foo where+          foo = "abc \+\def" ++ ""++test2 :: Int+test2 = foo where+          foo = let { x = 1;+ } in x+++--- All code indented?+  foo = 3+  bar = 4+-}
+ src/Text/Parsec/Indentation/Char.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}+module Text.Parsec.Indentation.Char where++import Text.Parsec.Prim (ParsecT, mkPT, runParsecT,+                         Stream(..),+                         Consumed(..), Reply(..),+                         State(..))+import Text.Parsec.Pos (sourceColumn)+import Text.Parser.Indentation.Implementation (Indentation)++----------------+-- Unicode char+-- newtype UnicodeIndentStream++----------------+-- Based on Char+{-# INLINE mkCharIndentStream #-}+mkCharIndentStream :: s -> CharIndentStream s+mkCharIndentStream s = CharIndentStream 1 s+data CharIndentStream s = CharIndentStream { charIndentStreamColumn :: {-# UNPACK #-} !Indentation,+                                             charIndentStreamStream :: !s } deriving (Show)++instance (Stream s m Char) => Stream (CharIndentStream s) m (Char, Indentation) where+  uncons (CharIndentStream i s) = do+    x <- uncons s+    case x of+      Nothing -> return Nothing+      Just (c, cs) -> return (Just ((c, i), CharIndentStream (updateColumn i c) cs))++{-# INLINE updateColumn #-}+updateColumn :: Integral a => a -> Char -> a+updateColumn _ '\n' = 1+updateColumn i '\t' = i + 8 - ((i-1) `mod` 8)+updateColumn i _    = i + 1++{-# INLINE charIndentStreamParser #-}+charIndentStreamParser :: (Monad m) => ParsecT s u m t -> ParsecT (CharIndentStream s) u m (t, Indentation)+charIndentStreamParser p = mkPT $ \state ->+  let go (Ok a state' e) = return (Ok (a, sourceColumn $ statePos state) (state' { stateInput = CharIndentStream (sourceColumn $ statePos state') (stateInput state') }) e)+      go (Error e) = return (Error e)+  in runParsecT p (state { stateInput = charIndentStreamStream (stateInput state) })+         >>= consumed (return . Consumed . go) (return . Empty . go)++{-# INLINE consumed #-}+consumed :: (Monad m) => (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b+consumed c _ (Consumed m) = m >>= c+consumed _ e (Empty m)    = m >>= e
+ src/Text/Parsec/Indentation/Examples/ISWIM.hs view
@@ -0,0 +1,61 @@+module Text.Parsec.Indentation.Examples.ISWIM where++-- Encodes example TODO from the paper TODO.+-- Note that because Parsec doesn't support full backtracking+-- this+--++import Control.Applicative ((<$>))+import Text.Parsec+import Text.Parsec.Indentation+import Text.Parsec.Indentation.Char++data ID = ID String deriving (Show, Eq)+data Expr+  = Where Expr ID Expr -- expr -> expr 'where' ID '=' |expr|>=+  | Plus Expr Expr     -- expr -> expr '+' expr+  | Minus Expr         -- expr -> '-' expr+  | Parens Expr        -- expr -> '(' expr* ')'+  | Var ID             -- expr -> ID+  deriving (Show, Eq)++runParse :: String -> Either ParseError Expr+runParse input+  = case runParser expr () "" (mkIndentStream 0 infIndentation True Ge (mkCharIndentStream input)) of+      Left err -> Left err+      Right a  -> Right a++-- Note that this grammar DOES NOT WORK as written because it contains+-- a left recursion.  (It diverges.)  However, it provides a good+-- first example to see how to use the combinators in+-- Text.Parsec.Indentation.++tok s = string s >> localTokenMode (const Any) (ignoreAbsoluteIndentation (many (char ' ' <|> char '\n')))+ident = choice (map f ["v", "w", "x", "y", "z"])+  where f x = tok x >> return (ID x)++expr = choice $ map try+    [ do e1 <- expr_nonrec+         tok "where"+         i <- ident+         tok "="+         e2 <- localIndentation Ge (absoluteIndentation expr)+         return (Where e1 i e2)+    , do e1 <- expr_nonrec+         tok "+"+         e2 <- expr+         return (Plus e1 e2)+    , expr_nonrec+    ]++expr_nonrec = choice+    [ tok "-" >> (Minus <$> expr)+    , Parens <$> between (tok "(") (tok ")") (localIndentation Any expr)+    , Var <$> ident+    ]+++input1 = "x + v where\n\+         \ x = -(\n\+         \y + z) + w"+output1 = runParse input1
+ src/Text/Parsec/Indentation/Examples/Parens.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}+module Text.Parsec.Indentation.Examples.Parens where++-- Encodes example TODO from the paper TODO.+-- Note that because Parsec doesn't support full backtracking+-- this++import Control.Applicative+import Text.Parsec+import Text.Parsec.Indentation++data A+  = Par A   -- '(' A ')'+  | Bra A   -- '[' A ']'+  | Seq A A -- A A+  | Nil     -- epsilon+  deriving (Show, Eq)++a :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A+a = choice [ Seq <$> a' <*> a, a', return Nil ]++a' :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A+a' = choice+    [ Par <$>+        between (localTokenMode (const Eq) $ char '(')+                (localTokenMode (const Eq) $ char ')')+                (localIndentation Gt a)+    , Bra <$>+        between (localTokenMode (const Ge) $ char '[')+                (localTokenMode (const Ge) $ char ']')+                (localIndentation Gt a)+    ]+++runParse input+  = case runParser a () "" (mkIndentStream 0 infIndentation True Gt input) of+      Left err -> Left (show err)+      Right a  -> Right a++input1 = [('(', 1),+          ('[', 4),+          ('(', 5),+          (')', 5),+          (']', 7),+          (')', 1)]+output1 = runParse input1++input2 = [('(', 1),+          ('[', 8),+          ('(', 6),+          (')', 6),+          ('[', 8),+          (']', 9),+          (']', 4),+          ('(', 3),+          (')', 3),+          (')', 1)]+output2 = runParse input2
+ src/Text/Parsec/Indentation/Token.hs view
@@ -0,0 +1,400 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}+{-# OPTIONS -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}+module Text.Parsec.Indentation.Token where++import Control.Monad.Identity+import Data.Char+import Data.List (nub, sort)+import Text.Parsec+import Text.Parsec.Token++import Text.Parsec.Indentation+import Text.Parsec.Indentation.Char (CharIndentStream(..), charIndentStreamParser)++type IndentLanguageDef st = GenLanguageDef (IndentStream (CharIndentStream String)) st Identity++makeIndentLanguageDef :: (Monad m) => GenLanguageDef s st m -> GenLanguageDef (IndentStream (CharIndentStream s)) st m+makeIndentLanguageDef l = l {+  identStart = indentStreamParser (charIndentStreamParser (identStart l)),+  identLetter = indentStreamParser (charIndentStreamParser (identLetter l)),+  opStart = indentStreamParser (charIndentStreamParser (opStart l)),+  opLetter = indentStreamParser (charIndentStreamParser (opLetter l))+  }++-- TODO: makeTokenParser :: (Stream (IndentStream s) m Char)+makeTokenParser :: (Stream s m (Char, Indentation))+                => GenLanguageDef (IndentStream s) u m -> GenTokenParser (IndentStream s) u m+makeTokenParser languageDef+    = TokenParser{ identifier = identifier+                 , reserved = reserved+                 , operator = operator+                 , reservedOp = reservedOp++                 , charLiteral = charLiteral+                 , stringLiteral = stringLiteral+                 , natural = natural+                 , integer = integer+                 , float = float+                 , naturalOrFloat = naturalOrFloat+                 , decimal = decimal+                 , hexadecimal = hexadecimal+                 , octal = octal++                 , symbol = symbol+                 , lexeme = lexeme+                 , whiteSpace = whiteSpace+                 , parens = parens+                 , braces = braces+                 , angles = angles+                 , brackets = brackets+                 , squares = brackets+                 , semi = semi+                 , comma = comma+                 , colon = colon+                 , dot = dot+                 , semiSep = semiSep+                 , semiSep1 = semiSep1+                 , commaSep = commaSep+                 , commaSep1 = commaSep1+                 }+    where++    -----------------------------------------------------------+    -- Bracketing+    -----------------------------------------------------------+    parens p        = between (symbol "(") (symbol ")") p+    braces p        = between (symbol "{") (symbol "}") p+    angles p        = between (symbol "<") (symbol ">") p+    brackets p      = between (symbol "[") (symbol "]") p++    semi            = symbol ";"+    comma           = symbol ","+    dot             = symbol "."+    colon           = symbol ":"++    commaSep p      = sepBy p comma+    semiSep p       = sepBy p semi++    commaSep1 p     = sepBy1 p comma+    semiSep1 p      = sepBy1 p semi+++    -----------------------------------------------------------+    -- Chars & Strings+    -----------------------------------------------------------+    charLiteral     = lexeme (between (char '\'')+                                      (char '\'' <?> "end of character")+                                      characterChar )+                    <?> "character"++    characterChar   = charLetter <|> charEscape+                    <?> "literal character"++    charEscape      = do{ char '\\'; escapeCode }+    charLetter      = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++++    stringLiteral   = lexeme (+                      do{ str <- between (char '"')+                                         (localTokenMode (const Any) (char '"' <?> "end of string"))+                                         (localTokenMode (const Any) (many stringChar))+                        ; return (foldr (maybe id (:)) "" str)+                        }+                      <?> "literal string")++    stringChar      =   do{ c <- stringLetter; return (Just c) }+                    <|> stringEscape+                    <?> "string character"++    stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++    stringEscape    = do{ char '\\'+                        ;     do{ escapeGap  ; return Nothing }+                          <|> do{ escapeEmpty; return Nothing }+                          <|> do{ esc <- escapeCode; return (Just esc) }+                        }++    escapeEmpty     = char '&'+    escapeGap       = do{ many1 space+                        ; char '\\' <?> "end of string gap"+                        }++++    -- escape codes+    escapeCode      = charEsc <|> charNum <|> charAscii <|> charControl+                    <?> "escape code"++    charControl     = do{ char '^'+                        ; code <- upper+                        ; return (toEnum (fromEnum code - fromEnum 'A'))+                        }++    charNum         = do{ code <- decimal+                                  <|> do{ char 'o'; number 8 octDigit }+                                  <|> do{ char 'x'; number 16 hexDigit }+                        ; return (toEnum (fromInteger code))+                        }++    charEsc         = choice (map parseEsc escMap)+                    where+                      parseEsc (c,code)     = do{ char c; return code }++    charAscii       = choice (map parseAscii asciiMap)+                    where+                      parseAscii (asc,code) = try (do{ string asc; return code })+++    -- escape code tables+    escMap          = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+    asciiMap        = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)++    ascii2codes     = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",+                       "FS","GS","RS","US","SP"]+    ascii3codes     = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",+                       "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",+                       "CAN","SUB","ESC","DEL"]++    ascii2          = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',+                       '\EM','\FS','\GS','\RS','\US','\SP']+    ascii3          = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',+                       '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',+                       '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+++    -----------------------------------------------------------+    -- Numbers+    -----------------------------------------------------------+    naturalOrFloat  = lexeme (natFloat) <?> "number"++    float           = lexeme floating   <?> "float"+    integer         = lexeme int        <?> "integer"+    natural         = lexeme nat        <?> "natural"+++    -- floats+    floating        = do{ n <- decimal+                        ; fractExponent n+                        }+++    natFloat        = do{ char '0'+                        ; zeroNumFloat+                        }+                      <|> decimalFloat++    zeroNumFloat    =  do{ n <- hexadecimal <|> octal+                         ; return (Left n)+                         }+                    <|> decimalFloat+                    <|> fractFloat 0+                    <|> return (Left 0)++    decimalFloat    = do{ n <- decimal+                        ; option (Left n)+                                 (fractFloat n)+                        }++    fractFloat n    = do{ f <- fractExponent n+                        ; return (Right f)+                        }++    fractExponent n = do{ fract <- fraction+                        ; expo  <- option 1.0 exponent'+                        ; return ((fromInteger n + fract)*expo)+                        }+                    <|>+                      do{ expo <- exponent'+                        ; return ((fromInteger n)*expo)+                        }++    fraction        = do{ char '.'+                        ; digits <- many1 digit <?> "fraction"+                        ; return (foldr op 0.0 digits)+                        }+                      <?> "fraction"+                    where+                      op d f    = (f + fromIntegral (digitToInt d))/10.0++    exponent'       = do{ oneOf "eE"+                        ; f <- sign+                        ; e <- decimal <?> "exponent"+                        ; return (power (f e))+                        }+                      <?> "exponent"+                    where+                       power e  | e < 0      = 1.0/power(-e)+                                | otherwise  = fromInteger (10^e)+++    -- integers and naturals+    int             = do{ f <- lexeme sign+                        ; n <- nat+                        ; return (f n)+                        }++    sign            =   (char '-' >> return negate)+                    <|> (char '+' >> return id)+                    <|> return id++    nat             = zeroNumber <|> decimal++    zeroNumber      = do{ char '0'+                        ; hexadecimal <|> octal <|> decimal <|> return 0+                        }+                      <?> ""++    decimal         = number 10 digit+    hexadecimal     = do{ oneOf "xX"; number 16 hexDigit }+    octal           = do{ oneOf "oO"; number 8 octDigit  }++    number base baseDigit+        = do{ digits <- many1 baseDigit+            ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+            ; seq n (return n)+            }++    -----------------------------------------------------------+    -- Operators & reserved ops+    -----------------------------------------------------------+    reservedOp name =+        lexeme $ try $+        do{ string name+          ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)+          }++    operator =+        lexeme $ try $+        do{ name <- oper+          ; if (isReservedOp name)+             then unexpected ("reserved operator " ++ show name)+             else return name+          }++    oper =+        do{ c <- (opStart languageDef)+          ; cs <- many (opLetter languageDef)+          ; return (c:cs)+          }+        <?> "operator"++    isReservedOp name =+        isReserved (sort (reservedOpNames languageDef)) name+++    -----------------------------------------------------------+    -- Identifiers & Reserved words+    -----------------------------------------------------------+    reserved name =+        lexeme $ try $+        do{ caseString name+          ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)+          }++    caseString name+        | caseSensitive languageDef  = string name+        | otherwise               = do{ walk name; return name }+        where+          walk []     = return ()+          walk (c:cs) = do{ caseChar c <?> msg; walk cs }++          caseChar c  | isAlpha c  = char (toLower c) <|> char (toUpper c)+                      | otherwise  = char c++          msg         = show name+++    identifier =+        lexeme $ try $+        do{ name <- ident+          ; if (isReservedName name)+             then unexpected ("reserved word " ++ show name)+             else return name+          }+++    ident+        = do{ c <- identStart languageDef+            ; cs <- many (identLetter languageDef)+            ; return (c:cs)+            }+        <?> "identifier"++    isReservedName name+        = isReserved theReservedNames caseName+        where+          caseName      | caseSensitive languageDef  = name+                        | otherwise               = map toLower name+++    isReserved names name+        = scan names+        where+          scan []       = False+          scan (r:rs)   = case (compare r name) of+                            LT  -> scan rs+                            EQ  -> True+                            GT  -> False++    theReservedNames+        | caseSensitive languageDef  = sort reserved+        | otherwise                  = sort . map (map toLower) $ reserved+        where+          reserved = reservedNames languageDef++++    -----------------------------------------------------------+    -- White space & symbols+    -----------------------------------------------------------+    symbol name+        = lexeme (string name)++    lexeme p+        = do{ x <- p; whiteSpace; return x  }++    whiteSpace = ignoreAbsoluteIndentation (localTokenMode (const Any) whiteSpace')+    whiteSpace'+        | noLine && noMulti  = skipMany (simpleSpace <?> "")+        | noLine             = skipMany (simpleSpace <|> multiLineComment <?> "")+        | noMulti            = skipMany (simpleSpace <|> oneLineComment <?> "")+        | otherwise          = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+        where+          noLine  = null (commentLine languageDef)+          noMulti = null (commentStart languageDef)++    simpleSpace =+        skipMany1 (satisfy isSpace)++    oneLineComment =+        do{ try (string (commentLine languageDef))+          ; skipMany (satisfy (/= '\n'))+          ; return ()+          }++    multiLineComment =+        do { try (string (commentStart languageDef))+           ; inComment+           }++    inComment+        | nestedComments languageDef  = inCommentMulti+        | otherwise                = inCommentSingle++    inCommentMulti+        =   do{ try (string (commentEnd languageDef)) ; return () }+        <|> do{ multiLineComment                     ; inCommentMulti }+        <|> do{ skipMany1 (noneOf startEnd)          ; inCommentMulti }+        <|> do{ oneOf startEnd                       ; inCommentMulti }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)++    inCommentSingle+        =   do{ try (string (commentEnd languageDef)); return () }+        <|> do{ skipMany1 (noneOf startEnd)         ; inCommentSingle }+        <|> do{ oneOf startEnd                      ; inCommentSingle }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)
+ tests/ParensParsec.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}+module ParensParsec where++import Control.Applicative+import Text.Parsec+import Text.Parsec.Indentation+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, assertEqual, assertFailure, Assertion)+                  ++data A+  = Par A   -- '(' A ')'+  | Bra A   -- '[' A ']'+  | Seq A A -- A A+  | Nil     -- epsilon+  deriving (Show, Eq)++a :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A+a = choice [ Seq <$> a' <*> a, a', return Nil ]++a' :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A+a' = choice+    [ Par <$>+        between (localTokenMode (const Eq) $ char '(')+                (localTokenMode (const Eq) $ char ')')+                (localIndentation Gt a)+    , Bra <$>+        between (localTokenMode (const Ge) $ char '[')+                (localTokenMode (const Ge) $ char ']')+                (localIndentation Gt a)+    ]+++runParse input+  = case runParser a () "" (mkIndentStream 0 infIndentation True Gt input) of+      Left err -> Left (show err)+      Right a  -> Right a++-- conveniences for tests+parL = Par . listToSeq+braL = Bra . listToSeq++listToSeq [] = Nil+listToSeq (x:xs) = Seq x $ listToSeq xs+    +input1 = [('(', 1),+          ('[', 4),+          ('(', 5),+          (')', 5),+          (']', 7),+          (')', 1)]+output1 = runParse input1+expected1 = listToSeq [ parL [braL [parL []]]+                      ]++input2 = [('(', 1),+          ('[', 8),+          ('(', 6),+          (')', 6),+          ('[', 8),+          (']', 9),+          (']', 4),+          ('(', 3),+          (')', 3),+          (')', 1)]+output2 = runParse input2+expected2 = listToSeq [ parL [ braL [ parL []+                                    , braL []+                                    ]+                             , parL []+                             ]+                      ]++assertParsedOk :: (Show err, Show a, Eq a) => Either err a -> a -> Assertion+assertParsedOk actual expected =+  case actual of+   Right ok -> assertEqual "parsing succeeded, but " expected ok+   Left err -> assertFailure ("parse failed with " ++ show err+                              ++ ", expected" ++ show expected)++allTests :: TestTree+allTests =+  testGroup "parens (parsec)"+  [ testCase "1" $ assertParsedOk output1 expected1+  , testCase "2" $ assertParsedOk output2 expected2+  ]
+ tests/all-tests.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}+module Main where++import Test.Tasty (defaultMain, testGroup)+import qualified ParensParsec ++main =+  defaultMain $ testGroup "All tests" $+  [+    ParensParsec.allTests+  ]