boomerang 1.0.1 → 1.1.0

raw patch · 3 files changed

+24/−15 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Boomerang/Combinators.hs +0/−6
• Text/Boomerang/TH.hs +23/−8
• boomerang.cabal +1/−1

@@ -121,24 +121,18 @@ rPair = xpure (arg (arg (:-)) (,)) $ \(ab :- t) -> do (a,b) <- Just ab; Just (a :- b :- t)  $(derivePrinterParsers ''Either)-rLeft  :: PrinterParser e tok (a :- r) (Either a b :- r)-rRight :: PrinterParser e tok (b :- r) (Either a b :- r)  -- | Combines a router for a value @a@ and a router for a value @b@ into a router for @Either a b@. rEither :: PrinterParser e tok r (a :- r) -> PrinterParser e tok r (b :- r) -> PrinterParser e tok r (Either a b :- r) rEither l r = rLeft . l <> rRight . r  $(derivePrinterParsers ''Maybe)-rNothing :: PrinterParser e tok       r  (Maybe a :- r)-rJust    :: PrinterParser e tok (a :- r) (Maybe a :- r)  -- | Converts a router for a value @a@ to a router for a @Maybe a@. rMaybe :: PrinterParser e tok r (a :- r) -> PrinterParser e tok r (Maybe a :- r) rMaybe r = rJust . r <> rNothing  $(derivePrinterParsers ''Bool)-rTrue  :: PrinterParser e tok r (Bool :- r)-rFalse :: PrinterParser e tok r (Bool :- r)  rBool :: PrinterParser e tok a r -- ^ 'True' parser       -> PrinterParser e tok a r -- ^ 'False' parser

@@ -4,7 +4,7 @@ import Control.Monad       (liftM, replicateM) import Language.Haskell.TH  import Text.Boomerang.HStack   ((:-)(..), arg)-import Text.Boomerang.Prim    (xpure)+import Text.Boomerang.Prim    (xpure, PrinterParser)  -- | Derive routers for all constructors in a datatype. For example:  --@@ -13,16 +13,16 @@ derivePrinterParsers name = do   info <- reify name   case info of-    TyConI (DataD _ _ _ cons _)   ->-      concat `liftM` mapM derivePrinterParser cons-    TyConI (NewtypeD _ _ _ con _) ->-      derivePrinterParser con+    TyConI (DataD _ tName tBinds cons _)   ->+      concat `liftM` mapM (derivePrinterParser (tName, tBinds)) cons+    TyConI (NewtypeD _ tName tBinds con _) ->+      derivePrinterParser (tName, tBinds) con     _ ->       fail $ show name ++ " is not a datatype."  -- Derive a router for a single constructor.-derivePrinterParser :: Con -> Q [Dec]-derivePrinterParser con =+derivePrinterParser :: (Name, [TyVarBndr]) -> Con -> Q [Dec]+derivePrinterParser (tName, tParams) con =   case con of     NormalC name tys -> go name (map snd tys)     RecC name tys -> go name (map (\(_,_,ty) -> ty) tys)@@ -30,12 +30,27 @@       runIO $ putStrLn $ "Skipping unsupported constructor " ++ show (conName con)       return []   where+    takeName (PlainTV n) = n+    takeName (KindedTV n _) = n     go name tys = do       let name' = mkPrinterParserName name+      let tok' = mkName "tok"+      let e' = mkName "e"+      let ppType = AppT (AppT (ConT ''PrinterParser) (VarT e')) (VarT tok')+      let r' = mkName "r"+      let inT = foldl (\a b -> AppT (AppT (ConT ''(:-)) b) a) (VarT r') tys+      let outT = AppT (AppT (ConT ''(:-))+                            (foldl AppT (ConT tName) (map (VarT . takeName) tParams)))+                      (VarT r')       runIO $ putStrLn $ "Introducing router " ++ nameBase name' ++ "."       expr <- [| xpure $(deriveConstructor name (length tys))                      $(deriveDestructor name tys) |]-      return [FunD name' [Clause [] (NormalB expr) []]]+      return [ SigD name'+                    (ForallT (map PlainTV ([tok', e', r'] ++ (map takeName tParams)))+                             []+                             (AppT (AppT ppType inT) outT))+             , FunD name' [Clause [] (NormalB expr) []]+             ]   -- Derive the contructor part of a router.

@@ -1,5 +1,5 @@ Name:             boomerang-Version:          1.0.1+Version:          1.1.0 License:          BSD3 License-File:     LICENSE Author:           jeremy@seereason.com