papillon 0.1.0.2 → 0.1.0.3
raw patch · 4 files changed
+45/−41 lines, 4 filesdep ~template-haskell
Dependency ranges changed: template-haskell
Files
- papillon.cabal +6/−6
- src/Text/Papillon/Core.hs +5/−3
- src/Text/Papillon/List.hs +33/−32
- src/Text/Papillon/Parser.hs +1/−0
papillon.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: papillon-version: 0.1.0.2+version: 0.1.0.3 stability: Experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -28,7 +28,7 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/papillon.git- tag: 0.1.0.2+ tag: 0.1.0.3 library hs-source-dirs: src@@ -39,16 +39,16 @@ Text.Papillon.Papillon, Text.Papillon.List build-depends:- base > 3 && < 5, template-haskell == 2.9.*,+ base > 3 && < 5, template-haskell == 2.10.*, monads-tf == 0.1.*, transformers == 0.4.*, bytestring == 0.10.*- ghc-options: -Wall+ ghc-options: -Wall -fno-warn-tabs executable papillon hs-source-dirs: bin main-is: papillon.hs other-modules: Class build-depends:- directory, filepath, base > 3 && < 5, template-haskell == 2.9.*,+ directory, filepath, base > 3 && < 5, template-haskell == 2.10.*, monads-tf == 0.1.*, transformers == 0.4.*, papillon- ghc-options: -Wall+ ghc-options: -Wall -fno-warn-tabs
src/Text/Papillon/Core.hs view
@@ -137,11 +137,13 @@ let decs = flip evalState vars $ (:) <$> (FunD pgn <$> (: []) <$> mkParseCore th prefix rets rules) <*> zipWithM mkr rules pg- list = if not $ listUsed pg then [] else listDec+ list = if not $ listUsed pg then return [] else listDec (getVariable "list" vars) (getVariable "list1" vars) th- opt = if not $ optionalUsed pg then [] else optionalDec+ opt = if not $ optionalUsed pg then return [] else optionalDec (getVariable "optional" vars) th- return $ flip (Clause []) (decs ++ list ++ opt) $ NormalB $+ lst <- list+ op <- opt+ return $ flip (Clause []) (decs ++ lst ++ op) $ NormalB $ VarE pgn `AppE` VarE (mkName "initialPos") where mkr rule (_, _, sel) =
src/Text/Papillon/List.hs view
@@ -34,27 +34,26 @@ a = mkName "a" p = mkName "p" -listDec :: Name -> Name -> Bool -> [Dec]-listDec list list1 th = [- SigD list $ ForallT [PlainTV m, PlainTV a]- ([ClassP (monadPlusN th) [vm],- ClassP (applicativeN th) [vm]]) $- ArrowT `AppT` (VarT m `AppT` VarT a)- `AppT` (VarT m `AppT` (ListT `AppT` VarT a)),- SigD list1 $ ForallT [PlainTV m, PlainTV a]- ([ClassP (monadPlusN th) [vm],- ClassP (applicativeN th) [vm]]) $- ArrowT `AppT` (VarT m `AppT` VarT a)- `AppT` (VarT m `AppT` (ListT `AppT` VarT a)),- FunD list $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $- InfixE (Just $ VarE list1 `AppE` VarE p)- (VarE $ mplusN th)- (Just returnEmpty),- FunD list1 $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $- InfixE (Just $ InfixE (Just cons) app (Just $ VarE p))- next- (Just $ VarE list `AppE` VarE p)- ] where+listDec :: Name -> Name -> Bool -> Q [Dec]+listDec list list1 th = do+ cp1 <- classP (monadPlusN th) [return vm]+ cp2 <- classP (applicativeN th) [return vm]+ return [+ SigD list $ ForallT [PlainTV m, PlainTV a] [cp1, cp2] $+ ArrowT `AppT` (VarT m `AppT` VarT a)+ `AppT` (VarT m `AppT` (ListT `AppT` VarT a)),+ SigD list1 $ ForallT [PlainTV m, PlainTV a] [cp1, cp2] $+ ArrowT `AppT` (VarT m `AppT` VarT a)+ `AppT` (VarT m `AppT` (ListT `AppT` VarT a)),+ FunD list $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $+ InfixE (Just $ VarE list1 `AppE` VarE p)+ (VarE $ mplusN th)+ (Just returnEmpty),+ FunD list1 $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $+ InfixE (Just $ InfixE (Just cons) app (Just $ VarE p))+ next+ (Just $ VarE list `AppE` VarE p) ]+ where vm = VarT m returnEmpty = VarE (mkName "return") `AppE` ListE [] cons = ConE $ mkName ":"@@ -68,17 +67,19 @@ -} -optionalDec :: Name -> Bool -> [Dec]-optionalDec optionalN th = [- SigD optionalN $ mplusAndApp $ (VarT m `AppT` VarT a) `arrT`- (VarT m `AppT` (ConT (mkName "Maybe") `AppT` VarT a)),- FunD optionalN $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $- ConE (mkName "Just") `app` VarE p `mplusE` returnNothing- ] where- mplusAndApp = ForallT [PlainTV m, PlainTV a] [- ClassP (monadPlusN th) [VarT m],- ClassP (applicativeN th) [VarT m]- ]+optionalDec :: Name -> Bool -> Q [Dec]+optionalDec optionalN th = do+ maa <- mplusAndApp $ (VarT m `AppT` VarT a) `arrT`+ (VarT m `AppT` (ConT (mkName "Maybe") `AppT` VarT a))+ return [+ SigD optionalN maa,+ FunD optionalN $ (: []) $ flip (Clause [VarP p]) [] $ NormalB $+ ConE (mkName "Just") `app` VarE p `mplusE` returnNothing ]+ where+ mplusAndApp x = do+ cp1 <- classP (monadPlusN th) [return $ VarT m]+ cp2 <- classP (applicativeN th) [return $ VarT m]+ return $ ForallT [PlainTV m, PlainTV a] [cp1, cp2] x arrT f x = ArrowT `AppT` f `AppT` x mplusE x = InfixE (Just x) (VarE $ mplusN th) . Just returnNothing = VarE (mkName "return") `AppE` ConE (mkName "Nothing")
src/Text/Papillon/Parser.hs view
@@ -35,6 +35,7 @@ ) where +import Prelude hiding (Word) import Text.Papillon.Papillon import "monads-tf" Control.Monad.State import "monads-tf" Control.Monad.Error