papillon (empty) → 0.0.1
raw patch · 6 files changed
+660/−0 lines, 6 filesdep +basedep +monads-tfdep +template-haskellsetup-changed
Dependencies added: base, monads-tf, template-haskell
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- papillon.cabal +41/−0
- src/Text/Papillon.hs +211/−0
- src/Text/Papillon/Parser.hs +372/−0
- src/papillon.hs +7/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2011, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of the Yoshikuni Jujo 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 EVEN 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
+ papillon.cabal view
@@ -0,0 +1,41 @@+build-type: Simple+cabal-version: >= 1.8++name: papillon+version: 0.0.1+stability: Experimental+author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>+maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>+homepage: yet++license: BSD3+license-file: LICENSE++category: Parsing+synopsis: packrat parser+description:+ blah blah blah++extra-source-files:++source-repository head+ type: git+ location: git://github.com/YoshikuniJujo/papillon.git++source-repository this+ type: git+ location: git://github.com/YoshikuniJujo/papillon.git+ tag: 0.0.1++library+ hs-source-dirs: src+ exposed-modules: Text.Papillon+ other-modules: Text.Papillon.Parser+ build-depends: base > 3 && < 5, template-haskell, monads-tf+ ghc-options: -Wall++executable papillon+ hs-source-dirs: src+ main-is: papillon.hs+ build-depends: base > 3 && < 5, template-haskell, monads-tf+ ghc-options: -Wall
+ src/Text/Papillon.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE TemplateHaskell, PackageImports #-}++module Text.Papillon (+ papillon,+ papillonStr,+ papillonStr',+ StateT(..),+-- flipMaybe+) where++import Language.Haskell.TH.Quote+import Language.Haskell.TH+import "monads-tf" Control.Monad.State++import Control.Applicative++import Text.Papillon.Parser+-- import Parser++-- dFlipMaybe :: DecsQ+-- dFlipMaybe = [d|+flipMaybe :: StateT s Maybe a -> StateT s Maybe ()+flipMaybe action = StateT $ \s -> case runStateT action s of+ Nothing -> Just ((), s)+ _ -> Nothing+-- |]++papillon :: QuasiQuoter+papillon = QuasiQuoter {+ quoteExp = undefined,+ quotePat = undefined,+ quoteType = undefined,+ quoteDec = declaration True+ }++papillonStr :: String -> IO String+papillonStr src = show . ppr <$> runQ (declaration False src)++papillonStr' :: String -> IO String+papillonStr' src = do+ let (pp, decsQ, atp) = declaration' src+ decs <- runQ decsQ+ return $ pp ++ "\n" ++ show (ppr decs) ++ "\n" ++ atp++flipMaybeN :: Bool -> Name+flipMaybeN True = 'flipMaybe+flipMaybeN False = mkName "flipMaybe"++returnN, failN, charN, maybeN, stateTN, stringN, putN, stateTN', msumN, getN ::+ Bool -> Name+returnN True = 'return+returnN False = mkName "return"+failN True = 'fail+failN False = mkName "fail"+charN True = ''Char+charN False = mkName "Char"+maybeN True = ''Maybe+maybeN False = mkName "Maybe"+stateTN True = ''StateT+stateTN False = mkName "StateT"+stringN True = ''String+stringN False = mkName "String"+putN True = 'put+putN False = mkName "put"+stateTN' True = 'StateT+stateTN' False = mkName "StateT"+msumN True = 'msum+msumN False = mkName "msum"+getN True = 'get+getN False = mkName "get"++declaration :: Bool -> String -> DecsQ+declaration th src = do+-- fm <- dFlipMaybe+ let parsed = case dv_peg $ parse src of+ Just (p, _) -> p+ _ -> error "bad"+ decParsed th parsed++declaration' :: String -> (String, DecsQ, String)+declaration' src = case dv_pegFile $ parse src of+ Just ((pp, p, atp), _) -> (pp, decParsed False p, atp)+ _ -> error "bad"++decParsed :: Bool -> Peg -> DecsQ+decParsed th parsed = do+-- debug <- flip (valD $ varP $ mkName "debug") [] $ normalB $+-- appE (varE $ mkName "putStrLn") (litE $ stringL "debug")+ r <- result th+ pm <- pmonad th+ d <- derivs th parsed+ pt <- parseT th+ p <- funD (mkName "parse") [parseE th parsed]+ tdvm <- typeDvM parsed+ dvsm <- dvSomeM th parsed+ tdvcm <- typeDvCharsM th+ dvcm <- dvCharsM th+ pts <- typeP parsed+ ps <- pSomes th parsed -- name expr+ return $ {- fm ++ -} [pm, r, d, pt, p] ++ tdvm ++ dvsm ++ [tdvcm, dvcm] ++ pts ++ ps+ where+-- c = clause [wildP] (normalB $ conE $ mkName "Nothing") []++derivs :: Bool -> Peg -> DecQ+derivs th peg = flip (dataD (cxt []) (mkName "Derivs") []) [] $ [+ recC (mkName "Derivs") $ (map derivs1 peg) ++ [+ varStrictType (mkName "dvChars") $ strictType notStrict $+ conT (mkName "Result") `appT` conT (charN th)+ ]+ ]++derivs1 :: Definition -> VarStrictTypeQ+derivs1 (name, typ, _) =+ varStrictType (mkName $ "dv_" ++ name) $ strictType notStrict $+ conT (mkName "Result") `appT` conT typ++result :: Bool -> DecQ+result th = tySynD (mkName "Result") [PlainTV $ mkName "v"] $ conT (maybeN th) `appT`+ (tupleT 2 `appT` varT (mkName "v") `appT` conT (mkName "Derivs"))++pmonad :: Bool -> DecQ+pmonad th = tySynD (mkName "PackratM") [] $ conT (stateTN th) `appT`+ conT (mkName "Derivs") `appT` conT (maybeN th)++parseT :: Bool -> DecQ+parseT th = sigD (mkName "parse") $+ arrowT `appT` conT (stringN th) `appT` conT (mkName "Derivs")+parseE :: Bool -> Peg -> ClauseQ+parseE th = parseE' th . map (\(n, _, _) -> n)+parseE' :: Bool -> [String] -> ClauseQ+parseE' th names = clause [varP $ mkName "s"] (normalB $ varE $ mkName "d") $ [+ flip (valD $ varP $ mkName "d") [] $ normalB $ appsE $+ conE (mkName "Derivs") :+ map (varE . mkName) names+ ++ [(varE $ mkName "char")]] +++ map parseE1 names ++ [+ flip (valD $ varP $ mkName "char") [] $ normalB $+ (varE $ mkName "flip") `appE` (varE $ mkName "runStateT") `appE`+ (varE $ mkName "d") `appE` (doE [+ bindS (infixP (varP $ mkName "c") (mkName ":")+ (varP $ mkName "s'")) $+ (varE $ returnN th) `appE`+ (varE $ mkName "s"),+ noBindS $ (varE $ putN th) `appE`+ (varE (mkName "parse") `appE`+ varE (mkName "s'")),+ noBindS $ (varE $ returnN th) `appE` varE (mkName "c")+ ])+ ]+parseE1 :: String -> DecQ+parseE1 name = flip (valD $ varP $ mkName name) [] $ normalB $+ (varE $ mkName "runStateT") `appE` (varE $ mkName $ "p_" ++ name)+ `appE` (varE $ mkName "d")++typeDvM :: Peg -> DecsQ+typeDvM = uncurry (zipWithM typeDvM1) . unzip . map (\(n, t, _) -> (n, t))++typeDvM1 :: String -> Name -> DecQ+typeDvM1 f t = sigD (mkName $ "dv_" ++ f ++ "M") $ conT (mkName "PackratM") `appT` conT t++dvSomeM :: Bool -> Peg -> DecsQ+dvSomeM th peg = mapM (dvSomeM1 th) peg++dvSomeM1 :: Bool -> Definition -> DecQ+dvSomeM1 th (name, _, _) = flip (valD $ varP $ mkName $ "dv_" ++ name ++ "M") [] $ normalB $+ conE (stateTN' th) `appE` varE (mkName $ "dv_" ++ name)++typeDvCharsM :: Bool -> DecQ+typeDvCharsM th =+ sigD (mkName $ "dvCharsM") $ conT (mkName "PackratM") `appT` conT (charN th)+dvCharsM :: Bool -> DecQ+dvCharsM th = flip (valD $ varP $ mkName "dvCharsM") [] $ normalB $+ conE (stateTN' th) `appE` varE (mkName "dvChars")++typeP :: Peg -> DecsQ+typeP = uncurry (zipWithM typeP1) . unzip . map (\(n, t, _) -> (n, t))++typeP1 :: String -> Name -> DecQ+typeP1 f t = sigD (mkName $ "p_" ++ f) $ conT (mkName "PackratM") `appT` conT t++pSomes :: Bool -> Peg -> DecsQ+pSomes th = mapM $ pSomes1 th++pSomes1 :: Bool -> Definition -> DecQ+pSomes1 th (name, _, sel) = flip (valD $ varP $ mkName $ "p_" ++ name) [] $ normalB $+ varE (msumN th) `appE` listE (map (uncurry $ pSome_ th) sel)++pSome_ :: Bool -> [NameLeaf] -> ExpQ -> ExpQ+pSome_ th nls ret = doE $+ concatMap (transLeaf th) nls ++ [noBindS $ (varE $ returnN th) `appE` ret]++transLeaf :: Bool -> NameLeaf -> [StmtQ]+transLeaf th (n, (Here (Right p))) = [+ bindS (varP n) $ varE $ mkName "dvCharsM",+ noBindS $ condE (p `appE` varE n)+ (varE (returnN th) `appE` conE (mkName "()"))+ (varE (failN th) `appE` litE (stringL "not match"))]+transLeaf _ (n, (Here (Left v))) = [+ bindS (varP n) $ varE $ mkName $ "dv_" ++ v ++ "M"]+transLeaf th (n, (NotAfter (Right p))) = [+ bindS (varP $ mkName "d") $ varE (getN th),+ bindS (varP n) $ varE $ mkName "dvCharsM",+ noBindS $ condE (p `appE` varE n)+ (varE (failN th) `appE` litE (stringL "not match"))+ (varE (returnN th) `appE` conE (mkName "()")),+ noBindS $ varE (putN th) `appE` (varE $ mkName "d")]+transLeaf th (_, (NotAfter (Left v))) = [+ bindS (varP $ mkName "d") $ varE (getN th),+ noBindS $ varE (flipMaybeN th) `appE`+ varE (mkName $ "dv_" ++ v ++ "M"),+ noBindS $ varE (putN th) `appE` (varE $ mkName "d")]
+ src/Text/Papillon/Parser.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE PackageImports #-}++module Text.Papillon.Parser (+ Peg,+ Definition,+ NameLeaf,+ parse,+ dv_peg,+ dv_pegFile,+ Leaf_(..)+) where++import Data.Char+import Control.Monad+import "monads-tf" Control.Monad.State+import Language.Haskell.TH++type Nil = ()+type Leaf = Either String ExR+data Leaf_ = NotAfter Leaf | Here Leaf+notAfter, here :: Leaf -> Leaf_+notAfter = NotAfter+here = Here+type NameLeaf = (Name, Leaf_)+type Expression = [NameLeaf]+type ExpressionHs = (Expression, ExR)+type Selection = [ExpressionHs]+type Typ = Name+type Definition = (String, Typ, Selection)+type Peg = [Definition]++type Ex = ExpQ -> ExpQ+type ExR = ExpQ++left :: b -> Either a b+right :: a -> Either a b+left = Right+right = Left++nil :: Nil+nil = ()++cons :: a -> [a] -> [a]+cons = (:)+mkNameLeaf :: String -> b -> (Name, b)+mkNameLeaf x y = (mkName x, y)+mkExpressionHs :: a -> Ex -> (a, ExR)+mkExpressionHs x y = (x, getEx y)+mkDef :: a -> String -> c -> (a, Name, c)+mkDef x y z = (x, mkName y, z)++toExp :: String -> Ex+toExp v = \f -> f `appE` varE (mkName v)++apply :: String -> Ex -> Ex+apply f x = \g -> x (toExp f g)++getEx :: Ex -> ExR+getEx ex = ex (varE $ mkName "id")++empty :: [a]+empty = []++type PegFile = (String, Peg, String)+mkPegFile :: a -> b -> c -> (a, b, c)+mkPegFile = (,,)++true :: Bool+true = True++isEqual, isSlash, isSemi,+ isColon, isOpenWave, isCloseWave, isLowerU, isNot :: Char -> Bool+isEqual = (== '=')+isSlash = (== '/')+isSemi = (== ';')+isColon = (== ':')+isOpenWave = (== '{')+isCloseWave = (== '}')+isLowerU c = isLower c || c == '_'+isNot = (== '!')++isOpenBr, isP, isA, isI, isL, isO, isN, isBar, isCloseBr, isNL :: Char -> Bool+[isOpenBr, isP, isA, isI, isL, isO, isN, isBar, isCloseBr, isNL] =+ map (==) "[pailon|]\n"++flipMaybe :: StateT s Maybe a -> StateT s Maybe ()+flipMaybe action = StateT $ \s -> case runStateT action s of+ Nothing -> Just ((), s)+ _ -> Nothing++type PackratM = StateT Derivs Maybe+type Result v = Maybe ((v, Derivs))+data Derivs+ = Derivs {dv_pegFile :: (Result PegFile),+ dv_prePeg :: (Result String),+ dv_afterPeg :: (Result String),+ dv_pap :: (Result Nil),+ dv_peg :: (Result Peg),+ dv_definition :: (Result Definition),+ dv_selection :: (Result Selection),+ dv_expressionHs :: (Result ExpressionHs),+ dv_expression :: (Result Expression),+ dv_nameLeaf :: (Result NameLeaf),+ dv_leaf_ :: (Result Leaf_),+ dv_leaf :: (Result Leaf),+ dv_test :: (Result ExR),+ dv_hsExp :: (Result Ex),+ dv_typ :: (Result String),+ dv_variable :: (Result String),+ dv_tvtail :: (Result String),+ dv_alpha :: (Result Char),+ dv_upper :: (Result Char),+ dv_lower :: (Result Char),+ dv_digit :: (Result Char),+ dv_spaces :: (Result Nil),+ dv_space :: (Result Nil),+ dvChars :: (Result Char)}+parse :: String -> Derivs+parse s = d+ where d = Derivs pegFile prePeg afterPeg pap peg definition selection expressionHs expression nameLeaf leaf_ leaf test hsExp typ variable tvtail alpha upper lower digit spaces space char+ pegFile = runStateT p_pegFile d+ prePeg = runStateT p_prePeg d+ afterPeg = runStateT p_afterPeg d+ pap = runStateT p_pap d+ peg = runStateT p_peg d+ definition = runStateT p_definition d+ selection = runStateT p_selection d+ expressionHs = runStateT p_expressionHs d+ expression = runStateT p_expression d+ nameLeaf = runStateT p_nameLeaf d+ leaf_ = runStateT p_leaf_ d+ leaf = runStateT p_leaf d+ test = runStateT p_test d+ hsExp = runStateT p_hsExp d+ typ = runStateT p_typ d+ variable = runStateT p_variable d+ tvtail = runStateT p_tvtail d+ alpha = runStateT p_alpha d+ upper = runStateT p_upper d+ lower = runStateT p_lower d+ digit = runStateT p_digit d+ spaces = runStateT p_spaces d+ space = runStateT p_space d+ char = flip runStateT d (do c : s' <- return s+ put (parse s')+ return c)+dv_pegFileM :: PackratM PegFile+dv_prePegM :: PackratM String+dv_afterPegM :: PackratM String+dv_papM :: PackratM Nil+dv_pegM :: PackratM Peg+dv_definitionM :: PackratM Definition+dv_selectionM :: PackratM Selection+dv_expressionHsM :: PackratM ExpressionHs+dv_expressionM :: PackratM Expression+dv_nameLeafM :: PackratM NameLeaf+dv_leaf_M :: PackratM Leaf_+dv_leafM :: PackratM Leaf+dv_testM :: PackratM ExR+dv_hsExpM :: PackratM Ex+dv_typM :: PackratM String+dv_variableM :: PackratM String+dv_tvtailM :: PackratM String+dv_alphaM :: PackratM Char+dv_upperM :: PackratM Char+dv_lowerM :: PackratM Char+dv_digitM :: PackratM Char+dv_spacesM :: PackratM Nil+dv_spaceM :: PackratM Nil+dv_pegFileM = StateT dv_pegFile+dv_prePegM = StateT dv_prePeg+dv_afterPegM = StateT dv_afterPeg+dv_papM = StateT dv_pap+dv_pegM = StateT dv_peg+dv_definitionM = StateT dv_definition+dv_selectionM = StateT dv_selection+dv_expressionHsM = StateT dv_expressionHs+dv_expressionM = StateT dv_expression+dv_nameLeafM = StateT dv_nameLeaf+dv_leaf_M = StateT dv_leaf_+dv_leafM = StateT dv_leaf+dv_testM = StateT dv_test+dv_hsExpM = StateT dv_hsExp+dv_typM = StateT dv_typ+dv_variableM = StateT dv_variable+dv_tvtailM = StateT dv_tvtail+dv_alphaM = StateT dv_alpha+dv_upperM = StateT dv_upper+dv_lowerM = StateT dv_lower+dv_digitM = StateT dv_digit+dv_spacesM = StateT dv_spaces+dv_spaceM = StateT dv_space+dvCharsM :: PackratM Char+dvCharsM = StateT dvChars+p_pegFile :: PackratM PegFile+p_prePeg :: PackratM String+p_afterPeg :: PackratM String+p_pap :: PackratM Nil+p_peg :: PackratM Peg+p_definition :: PackratM Definition+p_selection :: PackratM Selection+p_expressionHs :: PackratM ExpressionHs+p_expression :: PackratM Expression+p_nameLeaf :: PackratM NameLeaf+p_leaf_ :: PackratM Leaf_+p_leaf :: PackratM Leaf+p_test :: PackratM ExR+p_hsExp :: PackratM Ex+p_typ :: PackratM String+p_variable :: PackratM String+p_tvtail :: PackratM String+p_alpha :: PackratM Char+p_upper :: PackratM Char+p_lower :: PackratM Char+p_digit :: PackratM Char+p_spaces :: PackratM Nil+p_space :: PackratM Nil+p_pegFile = msum [do pp <- dv_prePegM+ _ <- dv_papM+ p <- dv_pegM+ _ <- dv_spacesM+ b <- dvCharsM+ if id isBar b then return () else fail "not match"+ c <- dvCharsM+ if id isCloseBr c then return () else fail "not match"+ n <- dvCharsM+ if id isNL n then return () else fail "not match"+ atp <- dv_afterPegM+ return (id mkPegFile pp p atp)]+p_prePeg = msum [do d <- get+ flipMaybe dv_papM+ put d+ c <- dvCharsM+ if id const true c then return () else fail "not match"+ pp <- dv_prePegM+ return (id cons c pp),+ do return (id empty)]+p_afterPeg = msum [do c <- dvCharsM+ if id const true c then return () else fail "not match"+ atp <- dv_afterPegM+ return (id cons c atp),+ do return (id empty)]+p_pap = msum [do nl <- dvCharsM+ if id isNL nl then return () else fail "not match"+ ob <- dvCharsM+ if id isOpenBr ob then return () else fail "not match"+ p <- dvCharsM+ if id isP p then return () else fail "not match"+ a <- dvCharsM+ if id isA a then return () else fail "not match"+ pp <- dvCharsM+ if id isP pp then return () else fail "not match"+ i <- dvCharsM+ if id isI i then return () else fail "not match"+ l <- dvCharsM+ if id isL l then return () else fail "not match"+ ll <- dvCharsM+ if id isL ll then return () else fail "not match"+ o <- dvCharsM+ if id isO o then return () else fail "not match"+ n <- dvCharsM+ if id isN n then return () else fail "not match"+ b <- dvCharsM+ if id isBar b then return () else fail "not match"+ nll <- dvCharsM+ if id isNL nll then return () else fail "not match"+ return (id nil)]+p_peg = msum [do _ <- dv_spacesM+ d <- dv_definitionM+ p <- dv_pegM+ return (id cons d p),+ do return (id empty)]+p_definition = msum [do v <- dv_variableM+ _ <- dv_spacesM+ c <- dvCharsM+ if id isColon c then return () else fail "not match"+ cc <- dvCharsM+ if id isColon cc then return () else fail "not match"+ _ <- dv_spacesM+ t <- dv_typM+ _ <- dv_spacesM+ e <- dvCharsM+ if id isEqual e then return () else fail "not match"+ _ <- dv_spacesM+ sel <- dv_selectionM+ _ <- dv_spacesM+ s <- dvCharsM+ if id isSemi s then return () else fail "not match"+ return (id mkDef v t sel)]+p_selection = msum [do ex <- dv_expressionHsM+ _ <- dv_spacesM+ e <- dvCharsM+ if id isSlash e then return () else fail "not match"+ _ <- dv_spacesM+ sel <- dv_selectionM+ return (id cons ex sel),+ do ex <- dv_expressionHsM+ return (id cons ex empty)]+p_expressionHs = msum [do e <- dv_expressionM+ _ <- dv_spacesM+ o <- dvCharsM+ if id isOpenWave o then return () else fail "not match"+ _ <- dv_spacesM+ h <- dv_hsExpM+ _ <- dv_spacesM+ c <- dvCharsM+ if id isCloseWave c then return () else fail "not match"+ return (id mkExpressionHs e h)]+p_expression = msum [do l <- dv_nameLeafM+ _ <- dv_spacesM+ e <- dv_expressionM+ return (id cons l e),+ do return (id empty)]+p_nameLeaf = msum [do n <- dv_variableM+ c <- dvCharsM+ if id isColon c then return () else fail "not match"+ l <- dv_leaf_M+ return (id mkNameLeaf n l)]+p_leaf_ = msum [do n <- dvCharsM+ if id isNot n then return () else fail "not match"+ l <- dv_leafM+ return (id notAfter l),+ do l <- dv_leafM+ return (id here l)]+p_leaf = msum [do t <- dv_testM+ return (id left t),+ do v <- dv_variableM+ return (id right v)]+p_test = msum [do o <- dvCharsM+ if id isOpenBr o then return () else fail "not match"+ h <- dv_hsExpM+ c <- dvCharsM+ if id isCloseBr c then return () else fail "not match"+ return (id getEx h)]+p_hsExp = msum [do v <- dv_variableM+ _ <- dv_spacesM+ h <- dv_hsExpM+ return (id apply v h),+ do v <- dv_variableM+ return (id toExp v)]+p_typ = msum [do u <- dv_upperM+ t <- dv_tvtailM+ return (id cons u t)]+p_variable = msum [do l <- dv_lowerM+ t <- dv_tvtailM+ return (id cons l t)]+p_tvtail = msum [do a <- dv_alphaM+ t <- dv_tvtailM+ return (id cons a t),+ do return (id empty)]+p_alpha = msum [do u <- dv_upperM+ return (id u),+ do l <- dv_lowerM+ return (id l),+ do d <- dv_digitM+ return (id d)]+p_upper = msum [do u <- dvCharsM+ if id isUpper u then return () else fail "not match"+ return (id u)]+p_lower = msum [do l <- dvCharsM+ if id isLowerU l then return () else fail "not match"+ return (id l)]+p_digit = msum [do d <- dvCharsM+ if id isDigit d then return () else fail "not match"+ return (id d)]+p_spaces = msum [do _ <- dv_spaceM+ _ <- dv_spacesM+ return (id nil),+ do return (id nil)]+p_space = msum [do l <- dvCharsM+ if id isSpace l then return () else fail "not match"+ return (id nil)]
+ src/papillon.hs view
@@ -0,0 +1,7 @@+import Text.Papillon+import System.Environment++main :: IO ()+main = do+ fn : _ <- getArgs+ putStr =<< papillonStr' =<< readFile fn