kure 2.16.12 → 2.18.6

raw patch · 25 files changed

+271/−295 lines, 25 filesdep ~basedep ~dlistdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, dlist, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• LICENSE +1/−1
• Language/KURE.hs +2/−2
• Language/KURE/BiTransform.hs +12/−16
• Language/KURE/Combinators.hs +2/−2
• Language/KURE/Combinators/Arrow.hs +2/−6
• Language/KURE/Combinators/Monad.hs +12/−7
• Language/KURE/Combinators/Transform.hs +37/−31
• Language/KURE/Debug.hs +4/−3
• Language/KURE/ExtendableContext.hs +2/−6
• Language/KURE/Injection.hs +14/−20
• Language/KURE/Lens.hs +10/−13
• Language/KURE/MonadCatch.hs +19/−18
• Language/KURE/Path.hs +12/−23
• Language/KURE/Pathfinder.hs +9/−7
• Language/KURE/Transform.hs +22/−31
• Language/KURE/Walker.hs +46/−32
• README.md +0/−3
• examples/Expr/Context.hs +6/−1
• examples/Expr/Kure.hs +16/−23
• examples/Fib/Kure.hs +1/−13
• examples/Lam/Examples.hs +1/−1
• examples/Lam/Kure.hs +11/−18
• examples/Lam/Monad.hs +14/−4
• kure.cabal +13/−14

@@ -1,3 +1,6 @@+## 2.18.6+* Maintenance update for GHC and base library changes involving Typeable, SemiGroup and MonadFail+ ## 2.16.12 * Derive `Typeable` instances 

@@ -1,4 +1,4 @@-(c) 2006-2015 The University of Kansas+(c) 2006-2021 The University of Kansas All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,9 +1,9 @@ -- | -- Module: Language.KURE--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --

@@ -1,12 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs #-} -- | -- Module: Language.KURE.BiTransform--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -38,8 +37,8 @@  import Control.Category -#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail) #endif  import Language.KURE.MonadCatch@@ -52,9 +51,6 @@ data BiTransform c m a b = BiTransform {forwardT :: Transform c m a b, -- ^ Extract the forward 'Transform' from a 'BiTransform'.                                         backwardT :: Transform c m b a  -- ^ Extract the backward 'Transform' from a 'BiTransform'.                                        }-#if __GLASGOW_HASKELL__ >= 708-  deriving Typeable-#endif  -- | A deprecated synonym for 'BiTranslate'. type BiTranslate c m a b = BiTransform c m a b@@ -102,50 +98,50 @@ ------------------------------------------------------------------------------------------  -- | As 'extractBiT', but takes a custom error message to use if extraction fails.-extractWithFailMsgBiT :: (Monad m, Injection a u, Injection b u) => String -> BiTransform c m u u -> BiTransform c m a b+extractWithFailMsgBiT :: (MonadFail m, Injection a u, Injection b u) => String -> BiTransform c m u u -> BiTransform c m a b extractWithFailMsgBiT msg (BiTransform t1 t2) = BiTransform (extractT t1 >>> projectWithFailMsgT msg)                                                             (extractT t2 >>> projectWithFailMsgT msg) {-# INLINE extractWithFailMsgBiT #-}  -- | Convert a bidirectional transformation over an injected value into a bidirectional transformation over non-injected values, --   (failing if an injected value cannot be projected).-extractBiT :: (Monad m, Injection a u, Injection b u) => BiTransform c m u u -> BiTransform c m a b+extractBiT :: (MonadFail m, Injection a u, Injection b u) => BiTransform c m u u -> BiTransform c m a b extractBiT = extractWithFailMsgBiT "extractBiT failed" {-# INLINE extractBiT #-}  -- | As 'promoteBiT', but takes a custom error message to use if promotion fails.-promoteWithFailMsgBiT  :: (Monad m, Injection a u, Injection b u) => String -> BiTransform c m a b -> BiTransform c m u u+promoteWithFailMsgBiT  :: (MonadFail m, Injection a u, Injection b u) => String -> BiTransform c m a b -> BiTransform c m u u promoteWithFailMsgBiT msg (BiTransform t1 t2) = BiTransform (projectWithFailMsgT msg >>> t1 >>> injectT)                                                             (projectWithFailMsgT msg >>> t2 >>> injectT) {-# INLINE promoteWithFailMsgBiT #-}  -- | Promote a bidirectional transformation from value to value into a transformation over an injection of those values, --   (failing if an injected value cannot be projected).-promoteBiT  :: (Monad m, Injection a u, Injection b u) => BiTransform c m a b -> BiTransform c m u u+promoteBiT  :: (MonadFail m, Injection a u, Injection b u) => BiTransform c m a b -> BiTransform c m u u promoteBiT = promoteWithFailMsgBiT "promoteBiT failed" {-# INLINE promoteBiT #-}  -- | As 'extractBiR', but takes a custom error message to use if extraction fails.-extractWithFailMsgBiR :: (Monad m, Injection a u) => String -> BiRewrite c m u -> BiRewrite c m a+extractWithFailMsgBiR :: (MonadFail m, Injection a u) => String -> BiRewrite c m u -> BiRewrite c m a extractWithFailMsgBiR msg (BiTransform r1 r2) = BiTransform (extractWithFailMsgR msg r1)                                                             (extractWithFailMsgR msg r2) {-# INLINE extractWithFailMsgBiR #-}  -- | Convert a bidirectional rewrite over an injected value into a bidirectional rewrite over a projection of that value, --   (failing if an injected value cannot be projected).-extractBiR :: (Monad m, Injection a u) => BiRewrite c m u -> BiRewrite c m a+extractBiR :: (MonadFail m, Injection a u) => BiRewrite c m u -> BiRewrite c m a extractBiR = extractWithFailMsgBiR "extractBiR failed" {-# INLINE extractBiR #-}  -- | As 'promoteBiR', but takes a custom error message to use if promotion fails.-promoteWithFailMsgBiR :: (Monad m, Injection a u) => String -> BiRewrite c m a -> BiRewrite c m u+promoteWithFailMsgBiR :: (MonadFail m, Injection a u) => String -> BiRewrite c m a -> BiRewrite c m u promoteWithFailMsgBiR msg (BiTransform r1 r2) = BiTransform (promoteWithFailMsgR msg r1)                                                             (promoteWithFailMsgR msg r2) {-# INLINE promoteWithFailMsgBiR #-}  -- | Promote a bidirectional rewrite over a value into a bidirectional rewrite over an injection of that value, --   (failing if an injected value cannot be projected).-promoteBiR :: (Monad m, Injection a u) => BiRewrite c m a -> BiRewrite c m u+promoteBiR :: (MonadFail m, Injection a u) => BiRewrite c m a -> BiRewrite c m u promoteBiR = promoteWithFailMsgBiR "promoteBiR failed" {-# INLINE promoteBiR #-} 

@@ -1,9 +1,9 @@ -- | -- Module: Language.KURE.Combinators--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --

@@ -1,10 +1,9 @@-{-# LANGUAGE CPP #-} -- | -- Module: Language.KURE.Combinators.Arrow--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -32,9 +31,6 @@ import Control.Category hiding ((.)) import Control.Arrow -#if __GLASGOW_HASKELL__ <= 708-import Data.Monoid-#endif import Data.Foldable  ------------------------------------------------------------------------------------------

@@ -1,9 +1,10 @@+{-# LANGUAGE CPP #-} -- | -- Module: Language.KURE.Combinators.Monad--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -21,20 +22,24 @@  import Control.Monad (unless) +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail(MonadFail)+#endif+ ------------------------------------------------------------------------------------------  -- | Similar to 'guard', but invokes 'fail' rather than 'mzero'.-guardMsg ::  Monad m => Bool -> String -> m ()+guardMsg ::  MonadFail m => Bool -> String -> m () guardMsg b msg = unless b (fail msg) {-# INLINE guardMsg #-}  -- | As 'guardMsg', but with a default error message.-guardM ::  Monad m => Bool -> m ()+guardM ::  MonadFail m => Bool -> m () guardM b = guardMsg b "guardM failed" {-# INLINE guardM #-}  -- | As 'guardMsg', but with an @m Bool@ as argument.-guardMsgM :: Monad m => m Bool -> String -> m ()+guardMsgM :: MonadFail m => m Bool -> String -> m () guardMsgM mb msg = do b <- mb                       guardMsg b msg {-# INLINE guardMsgM #-}@@ -46,12 +51,12 @@ {-# INLINE ifM #-}  -- | If the monadic predicate holds then perform the monadic action, else fail.-whenM ::  Monad m => m Bool -> m a -> m a+whenM ::  MonadFail m => m Bool -> m a -> m a whenM mb ma = ifM mb ma (fail "whenM: condition False") {-# INLINE whenM #-}  -- | If the monadic predicate holds then fail, else perform the monadic action.-unlessM ::  Monad m => m Bool -> m a -> m a+unlessM ::  MonadFail m => m Bool -> m a -> m a unlessM mb ma = ifM mb (fail "unlessM: condition True") ma {-# INLINE unlessM #-} 

@@ -1,12 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs #-} -- | -- Module: Language.KURE.Combinators.Transform--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -52,18 +51,17 @@  import Prelude hiding (id, map, foldr, mapM) -#if __GLASGOW_HASKELL__ <= 708-import Control.Applicative-#endif import Control.Category ((>>>),id) import Control.Monad (liftM,ap) -import Data.Foldable-import Data.Traversable-#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+import qualified Control.Monad.Fail #endif +import Data.Foldable ()+import Data.Traversable+ import Language.KURE.Combinators.Arrow import Language.KURE.Combinators.Monad import Language.KURE.MonadCatch@@ -132,17 +130,17 @@ {-# INLINE orR #-}  -- | As 'acceptR', but takes a custom failure message.-acceptWithFailMsgR :: Monad m => (a -> Bool) -> String -> Rewrite c m a+acceptWithFailMsgR :: MonadFail m => (a -> Bool) -> String -> Rewrite c m a acceptWithFailMsgR p msg = readerT $ \ a -> if p a then id else fail msg {-# INLINE acceptWithFailMsgR #-}  -- | Look at the argument to a rewrite, and choose to be either 'idR' or a failure.-acceptR :: Monad m => (a -> Bool) -> Rewrite c m a+acceptR :: MonadFail m => (a -> Bool) -> Rewrite c m a acceptR p = acceptWithFailMsgR p "acceptR: predicate failed" {-# INLINE acceptR #-}  -- | A generalisation of 'acceptR' where the predicate is a 'Transform'.-accepterR :: Monad m => Transform c m a Bool -> Rewrite c m a+accepterR :: MonadFail m => Transform c m a Bool -> Rewrite c m a accepterR t = ifM t idR (fail "accepterR: predicate failed") {-# INLINE accepterR #-} @@ -183,7 +181,7 @@ {-# INLINE joinT #-}  -- | Fail if the Boolean is False, succeed if the Boolean is True.-guardT :: Monad m => Transform c m Bool ()+guardT :: MonadFail m => Transform c m Bool () guardT = contextfreeT guardM {-# INLINE guardT #-} @@ -195,7 +193,7 @@   fmap :: (a -> b) -> PBool a -> PBool b   fmap f (PBool b a) = PBool b (f a) -checkSuccessPBool :: Monad m => String -> m (PBool a) -> m a+checkSuccessPBool :: MonadFail m => String -> m (PBool a) -> m a checkSuccessPBool msg m = do PBool b a <- m                              if b                                then return a@@ -212,9 +210,6 @@ --   causes a sequence of rewrites to succeed if at least one succeeds, converting failures to --   identity rewrites. newtype AnyR m a = AnyR (m (PBool a))-#if __GLASGOW_HASKELL__ >= 708-  deriving Typeable-#endif  unAnyR :: AnyR m a -> m (PBool a) unAnyR (AnyR mba) = mba@@ -239,16 +234,23 @@    return = AnyR . return . PBool False    {-# INLINE return #-} -   fail :: String -> AnyR m a-   fail = AnyR . fail-   {-# INLINE fail #-}-    (>>=) :: AnyR m a -> (a -> AnyR m d) -> AnyR m d    ma >>= f = AnyR $ do PBool b1 a <- unAnyR ma                         PBool b2 d <- unAnyR (f a)                         return (PBool (b1 || b2) d)    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> AnyR m a+   fail = AnyR . fail+   {-# INLINE fail #-}+#endif++instance MonadFail m => MonadFail (AnyR m) where+   fail :: String -> AnyR m a+   fail = AnyR . fail+   {-# INLINE fail #-}+ instance MonadCatch m => MonadCatch (AnyR m) where    catchM :: AnyR m a -> (String -> AnyR m a) -> AnyR m a    catchM ma f = AnyR (unAnyR ma `catchM` (unAnyR . f))@@ -260,7 +262,7 @@ {-# INLINE wrapAnyR #-}  -- | Unwrap a 'Rewrite' from the 'AnyR' monad transformer.-unwrapAnyR :: Monad m => Rewrite c (AnyR m) a -> Rewrite c m a+unwrapAnyR :: MonadFail m => Rewrite c (AnyR m) a -> Rewrite c m a unwrapAnyR = resultT (checkSuccessPBool "anyR failed" . unAnyR) {-# INLINE unwrapAnyR #-} @@ -274,9 +276,6 @@ -- | The 'OneR' transformer, in combination with 'wrapOneR' and 'unwrapOneR', --   causes a sequence of rewrites to only apply the first success, converting the remainder (and failures) to identity rewrites. newtype OneR m a = OneR (Bool -> m (PBool a))-#if __GLASGOW_HASKELL__ >= 708-  deriving Typeable-#endif  unOneR :: OneR m a -> Bool -> m (PBool a) unOneR (OneR mba) = mba@@ -301,15 +300,22 @@    return a = OneR (\ b -> return (PBool b a))    {-# INLINE return #-} -   fail :: String -> OneR m a-   fail msg = OneR (\ _ -> fail msg)-   {-# INLINE fail #-}-    (>>=) :: OneR m a -> (a -> OneR m d) -> OneR m d    ma >>= f = OneR $ \ b1 -> do PBool b2 a <- unOneR ma b1                                 unOneR (f a) b2    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> OneR m a+   fail msg = OneR (\ _ -> fail msg)+   {-# INLINE fail #-}+#endif++instance MonadFail m => MonadFail (OneR m) where+   fail :: String -> OneR m a+   fail msg = OneR (\ _ -> fail msg)+   {-# INLINE fail #-}+ instance MonadCatch m => MonadCatch (OneR m) where    catchM :: OneR m a -> (String -> OneR m a) -> OneR m a    catchM (OneR g) f = OneR (\ b -> g b `catchM` (($ b) . unOneR . f))@@ -323,7 +329,7 @@ {-# INLINE wrapOneR #-}  -- | Unwrap a 'Rewrite' from the 'OneR' monad transformer.-unwrapOneR :: Monad m => Rewrite c (OneR m) a -> Rewrite c m a+unwrapOneR :: MonadFail m => Rewrite c (OneR m) a -> Rewrite c m a unwrapOneR = resultT (checkSuccessPBool "oneR failed" . ($ False) . unOneR) {-# INLINE unwrapOneR #-} 

@@ -1,9 +1,9 @@ -- | -- Module: Language.KURE.Debug--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -13,6 +13,7 @@         debugR ) where +import Control.Monad.Fail import Debug.Trace  import Language.KURE.Combinators.Transform@@ -20,5 +21,5 @@   -- | Trace output of the value being rewritten; use for debugging only.-debugR :: (Monad m, Show a) => Int -> String -> Rewrite c m a+debugR :: (MonadFail m, Show a) => Int -> String -> Rewrite c m a debugR n msg = acceptR (\ a -> trace (msg ++ " : " ++ take n (show a)) True)

@@ -1,14 +1,13 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module: Language.KURE.ExtendableContext--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -25,8 +24,6 @@         , extraContext ) where -import Data.Typeable- import Language.KURE.Path  ------------------------------------------------------------------------------------------------@@ -38,7 +35,6 @@                              -- | Retrieve the extra contextual information.                            , extraContext  :: e                            }-  deriving Typeable  -- | Extend a context with some additional information. extendContext :: e -> c -> ExtendContext c e

@@ -1,15 +1,13 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE StandaloneDeriving #-} -- | -- Module: Language.KURE.Injection--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -39,8 +37,8 @@  import Control.Arrow -#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail) #endif  import Language.KURE.Transform@@ -56,10 +54,6 @@   inject  :: a -> u   project :: u -> Maybe a -#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable Injection-#endif- -- | There is an identity injection for all types. instance Injection a a where   inject :: a -> a@@ -87,12 +81,12 @@ {-# INLINE injectM #-}  -- | As 'projectM', but takes a custom error message to use if projection fails.-projectWithFailMsgM :: (Monad m, Injection a u) => String -> u -> m a+projectWithFailMsgM :: (MonadFail m, Injection a u) => String -> u -> m a projectWithFailMsgM msg = maybe (fail msg) return . project {-# INLINE projectWithFailMsgM #-}  -- | Projects a value and lifts it into a 'Monad', with the possibility of failure.-projectM :: (Monad m, Injection a u) => u -> m a+projectM :: (MonadFail m, Injection a u) => u -> m a projectM = projectWithFailMsgM "projectM failed" {-# INLINE projectM #-} @@ -103,12 +97,12 @@ injectT = arr inject {-# INLINE injectT #-} -projectWithFailMsgT :: (Monad m, Injection a u) => String -> Transform c m u a+projectWithFailMsgT :: (MonadFail m, Injection a u) => String -> Transform c m u a projectWithFailMsgT = contextfreeT . projectWithFailMsgM {-# INLINE projectWithFailMsgT #-}  -- | Lifted 'project', the transformation fails if the projection fails.-projectT :: (Monad m, Injection a u) => Transform c m u a+projectT :: (MonadFail m, Injection a u) => Transform c m u a projectT = projectWithFailMsgT "projectT failed" {-# INLINE projectT #-} @@ -118,35 +112,35 @@ {-# INLINE extractT #-}  -- | As 'promoteT', but takes a custom error message to use if promotion fails.-promoteWithFailMsgT  :: (Monad m, Injection a u) => String -> Transform c m a b -> Transform c m u b+promoteWithFailMsgT  :: (MonadFail m, Injection a u) => String -> Transform c m a b -> Transform c m u b promoteWithFailMsgT msg t = projectWithFailMsgT msg >>> t {-# INLINE promoteWithFailMsgT #-}  -- | Promote a transformation over a value into a transformation over an injection of that value, --   (failing if that injected value cannot be projected).-promoteT  :: (Monad m, Injection a u) => Transform c m a b -> Transform c m u b+promoteT  :: (MonadFail m, Injection a u) => Transform c m a b -> Transform c m u b promoteT = promoteWithFailMsgT "promoteT failed" {-# INLINE promoteT #-}  -- | As 'extractR', but takes a custom error message to use if extraction fails.-extractWithFailMsgR :: (Monad m, Injection a u) => String -> Rewrite c m u -> Rewrite c m a+extractWithFailMsgR :: (MonadFail m, Injection a u) => String -> Rewrite c m u -> Rewrite c m a extractWithFailMsgR msg r = injectT >>> r >>> projectWithFailMsgT msg {-# INLINE extractWithFailMsgR #-}  -- | Convert a rewrite over an injected value into a rewrite over a projection of that value, --   (failing if that injected value cannot be projected).-extractR :: (Monad m, Injection a u) => Rewrite c m u -> Rewrite c m a+extractR :: (MonadFail m, Injection a u) => Rewrite c m u -> Rewrite c m a extractR = extractWithFailMsgR "extractR failed" {-# INLINE extractR #-}  -- | As 'promoteR', but takes a custom error message to use if promotion fails.-promoteWithFailMsgR :: (Monad m, Injection a u) => String -> Rewrite c m a -> Rewrite c m u+promoteWithFailMsgR :: (MonadFail m, Injection a u) => String -> Rewrite c m a -> Rewrite c m u promoteWithFailMsgR msg r = projectWithFailMsgT msg >>> r >>> injectT {-# INLINE promoteWithFailMsgR #-}  -- | Promote a rewrite over a value into a rewrite over an injection of that value, --   (failing if that injected value cannot be projected).-promoteR  :: (Monad m, Injection a u) => Rewrite c m a -> Rewrite c m u+promoteR  :: (MonadFail m, Injection a u) => Rewrite c m a -> Rewrite c m u promoteR = promoteWithFailMsgR "promoteR failed" {-# INLINE promoteR #-} 

@@ -1,12 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs #-} -- | -- Module: Language.KURE.Lens--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -31,13 +30,14 @@ import Prelude hiding (id, (.))  import Control.Monad-import Control.Category-import Control.Arrow -#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail) #endif +import Control.Category+import Control.Arrow+ import Language.KURE.MonadCatch import Language.KURE.Transform import Language.KURE.BiTransform@@ -49,9 +49,6 @@ -- | A 'Lens' is a way to focus on a sub-structure of type @b@ from a structure of type @a@. newtype Lens c m a b = Lens { -- | Convert a 'Lens' into a 'Transform' that produces a sub-structure (and its context) and an unfocussing function.                               lensT :: Transform c m a ((c,b), b -> m a)}-#if __GLASGOW_HASKELL__ >= 708-  deriving Typeable-#endif  -- | The primitive way of building a 'Lens'. --   If the unfocussing function is applied to the value focussed on then it should succeed,@@ -90,7 +87,7 @@    {-# INLINE (.) #-}  -- | The failing 'Lens'.-failL :: Monad m => String -> Lens c m a b+failL :: MonadFail m => String -> Lens c m a b failL = lens . fail {-# INLINE failL #-} @@ -117,12 +114,12 @@ ------------------------------------------------------------------------------------------  -- | A 'Lens' to the injection of a value.-injectL  :: (Monad m, Injection a g) => Lens c m a g+injectL  :: (MonadFail m, Injection a g) => Lens c m a g injectL = lens $ transform $ \ c a -> return ((c, inject a), projectM) {-# INLINE injectL #-}  -- | A 'Lens' to the projection of a value.-projectL :: (Monad m, Injection a g) => Lens c m g a+projectL :: (MonadFail m, Injection a g) => Lens c m g a projectL = lens $ transform $ \ c -> projectM >=> (\ a -> return ((c,a), injectM)) {-# INLINE projectL #-} 

@@ -1,13 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE StandaloneDeriving #-} -- | -- Module: Language.KURE.MonadCatch--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -40,20 +38,20 @@ import Prelude hiding (foldr)  import Control.Exception (catch, SomeException)-import Control.Monad++#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+import qualified Control.Monad.Fail+#endif++import Control.Monad (liftM, ap, join) import Control.Monad.IO.Class  import Data.Foldable import Data.List (isPrefixOf)-import Data.Typeable  import Language.KURE.Combinators.Monad -#if __GLASGOW_HASKELL__ <= 708-import Control.Applicative-import Data.Monoid-#endif- infixl 3 <+  ------------------------------------------------------------------------------------------@@ -64,21 +62,17 @@ -- > fail msg `catchM` f == f msg -- > return a `catchM` f == return a -class Monad m => MonadCatch m where+class MonadFail m => MonadCatch m where   -- | Catch a failing monadic computation.   catchM :: m a -> (String -> m a) -> m a -#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable MonadCatch-#endif- ------------------------------------------------------------------------------------------  -- | 'KureM' is the minimal structure that can be an instance of 'MonadCatch'. --   The KURE user is free to either use 'KureM' or provide their own monad. --   'KureM' is essentially the same as 'Either' 'String', except that it supports a 'MonadCatch' instance which 'Either' 'String' does not (because its 'fail' method calls 'error') --   A major advantage of this is that monadic pattern match failures are caught safely.-data KureM a = Failure String | Success a deriving (Eq, Show, Typeable)+data KureM a = Failure String | Success a deriving (Eq, Show)  -- | Eliminator for 'KureM'. runKureM :: (a -> b) -> (String -> b) -> KureM a -> b@@ -92,7 +86,7 @@ {-# INLINE fromKureM #-}  -- | Lift a 'KureM' computation to any other monad.-liftKureM :: Monad m => KureM a -> m a+liftKureM :: MonadFail m => KureM a -> m a liftKureM = runKureM return fail {-# INLINE liftKureM #-} @@ -106,6 +100,13 @@    (Failure msg) >>= _ = Failure msg    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> KureM a+   fail = Failure+   {-# INLINE fail #-}+#endif++instance MonadFail KureM where    fail :: String -> KureM a    fail = Failure    {-# INLINE fail #-}

@@ -1,16 +1,14 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE StandaloneDeriving #-} -- | -- Module: Language.KURE.Path--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -43,13 +41,11 @@        ) where -#if __GLASGOW_HASKELL__ <= 708-import Data.Monoid-#endif- import Control.Arrow ((>>^)) -import Data.Typeable+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif  import Language.KURE.Transform import Language.KURE.Combinators.Transform@@ -64,17 +60,18 @@ -------------------------------------------------------------------------------  -- | A 'SnocPath' is a list stored in reverse order.-newtype SnocPath crumb = SnocPath [crumb] deriving (Eq, Typeable)+newtype SnocPath crumb = SnocPath [crumb] deriving Eq +instance Semigroup (SnocPath crumb) where+  (<>) :: SnocPath crumb -> SnocPath crumb -> SnocPath crumb+  (SnocPath p1) <> (SnocPath p2) = SnocPath (p2 ++ p1)+  {-# INLINE (<>) #-}+ instance Monoid (SnocPath crumb) where    mempty :: SnocPath crumb    mempty = SnocPath []    {-# INLINE mempty #-} -   mappend :: SnocPath crumb -> SnocPath crumb -> SnocPath crumb-   mappend (SnocPath p1) (SnocPath p2) = SnocPath (p2 ++ p1)-   {-# INLINE mappend #-}- instance Functor SnocPath where    fmap :: (a -> b) -> SnocPath a -> SnocPath b    fmap f (SnocPath p) = SnocPath (map f p)@@ -114,10 +111,6 @@   -- | Extend the current 'AbsolutePath' by one crumb.   (@@) :: c -> crumb -> c -#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable ExtendPath-#endif- -- | A 'SnocPath' from the root. type AbsolutePath = SnocPath @@ -129,17 +122,13 @@   -- | Read the current absolute path.   absPath :: c -> AbsolutePath crumb -#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable ReadPath-#endif- -- | Lifted version of 'absPath'. absPathT :: (ReadPath c crumb, Monad m) => Transform c m a (AbsolutePath crumb) absPathT = contextT >>^ absPath {-# INLINE absPathT #-}  -- | Lifted version of 'lastCrumb'.-lastCrumbT :: (ReadPath c crumb, Monad m) => Transform c m a crumb+lastCrumbT :: (ReadPath c crumb, MonadFail m) => Transform c m a crumb lastCrumbT = contextonlyT (projectWithFailMsgM (fail "lastCrumbT failed: at the root, no crumbs yet.") . lastCrumb . absPath) {-# INLINE lastCrumbT #-} 

@@ -1,13 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}- -- | -- Module: Language.KURE.Pathfinder--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -34,10 +33,13 @@         , uniquePrunePathToT ) where +import Prelude+ import Control.Category hiding ((.)) import Control.Arrow-#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (mempty)++#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail) #endif  import Language.KURE.MonadCatch@@ -63,7 +65,7 @@ {-# INLINE exposeLocalPathT #-}  -- | Return the current 'LocalPath' if the predicate transformation succeeds.-acceptLocalPathT :: Monad m => Transform c m u Bool -> Transform (WithLocalPath c crumb) m u (LocalPath crumb)+acceptLocalPathT :: MonadFail m => Transform c m u Bool -> Transform (WithLocalPath c crumb) m u (LocalPath crumb) acceptLocalPathT q = accepterR (liftContext baseContext q) >>> exposeLocalPathT {-# INLINE acceptLocalPathT #-} @@ -93,7 +95,7 @@   -- local function used by uniquePathToT and uniquePrunePathToT-requireUniquePath :: Monad m => Transform c m [LocalPath crumb] (LocalPath crumb)+requireUniquePath :: MonadFail m => Transform c m [LocalPath crumb] (LocalPath crumb) requireUniquePath = contextfreeT $ \ ps -> case ps of                                              []  -> fail "No matching nodes found."                                              [p] -> return p

@@ -1,13 +1,12 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} -- | -- Module: Language.KURE.Transform--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -37,17 +36,16 @@  import Control.Applicative import Control.Monad++#if !MIN_VERSION_base(4,13,0)+import qualified Control.Monad.Fail+import Control.Monad.Fail (MonadFail)+#endif+ import Control.Monad.IO.Class import Control.Category import Control.Arrow -#if __GLASGOW_HASKELL__ <= 708-import Data.Monoid-#endif-#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable-#endif- import Language.KURE.MonadCatch  ------------------------------------------------------------------------------------------@@ -56,9 +54,6 @@ --   The 'Transform' type is the basis of the entire KURE library. newtype Transform c m a b = Transform { -- | Apply a transformation to a value and its context.                                         applyT :: c -> a -> m b}-#if __GLASGOW_HASKELL__ >= 708-  deriving Typeable-#endif  -- | A deprecated synonym for 'Transform'. type Translate c m a b = Transform c m a b@@ -119,14 +114,12 @@  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance Functor m => Functor (Transform c m a) where-    fmap :: (b -> d) -> Transform c m a b -> Transform c m a d    fmap f t = transform (\ c -> fmap f . applyT t c)    {-# INLINE fmap #-}  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance Applicative m => Applicative (Transform c m a) where-    pure :: b -> Transform c m a b    pure = constT . pure    {-# INLINE pure #-}@@ -137,7 +130,6 @@  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance Alternative m => Alternative (Transform c m a) where-    empty :: Transform c m a b    empty = constT empty    {-# INLINE empty #-}@@ -148,7 +140,6 @@  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance Monad m => Monad (Transform c m a) where-    return :: b -> Transform c m a b    return = constT . return    {-# INLINE return #-}@@ -158,20 +149,26 @@                                      applyT (f b) c a    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)    fail :: String -> Transform c m a b    fail = constT . fail    {-# INLINE fail #-}+#endif  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment.-instance MonadCatch m => MonadCatch (Transform c m a) where+instance MonadFail m => MonadFail (Transform c m a) where+   fail :: String -> Transform c m a b+   fail = constT . fail+   {-# INLINE fail #-} +-- | Lifting through a Reader transformer, where (c,a) is the read-only environment.+instance MonadCatch m => MonadCatch (Transform c m a) where    catchM :: Transform c m a b -> (String -> Transform c m a b) -> Transform c m a b    catchM t1 t2 = transform $ \ c a -> applyT t1 c a `catchM` \ msg -> applyT (t2 msg) c a    {-# INLINE catchM #-}  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance MonadPlus m => MonadPlus (Transform c m a) where-    mzero :: Transform c m a b    mzero = constT mzero    {-# INLINE mzero #-}@@ -182,7 +179,6 @@  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance MonadIO m => MonadIO (Transform c m a) where-    liftIO :: IO b -> Transform c m a b    liftIO = constT . liftIO    {-# INLINE liftIO #-}@@ -191,7 +187,6 @@  -- | The 'Kleisli' 'Category' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance Monad m => Category (Transform c m) where-    id :: Transform c m a a    id = contextfreeT return    {-# INLINE id #-}@@ -200,10 +195,8 @@    t2 . t1 = transform (\ c -> applyT t1 c >=> applyT t2 c)    {-# INLINE (.) #-} - -- | The 'Kleisli' 'Arrow' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance Monad m => Arrow (Transform c m) where-    arr :: (a -> b) -> Transform c m a b    arr f = contextfreeT (return . f)    {-# INLINE arr #-}@@ -226,21 +219,18 @@  -- | The 'Kleisli' 'Arrow' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance MonadPlus m => ArrowZero (Transform c m) where-    zeroArrow :: Transform c m a b    zeroArrow = mzero    {-# INLINE zeroArrow #-}  -- | The 'Kleisli' 'Arrow' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance MonadPlus m => ArrowPlus (Transform c m) where-    (<+>) :: Transform c m a b -> Transform c m a b -> Transform c m a b    (<+>) = mplus    {-# INLINE (<+>) #-}  -- | The 'Kleisli' 'Arrow' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance Monad m => ArrowApply (Transform c m) where-    app :: Transform c m (Transform c m a b, a) b    app = transform (\ c (t,a) -> applyT t c a)    {-# INLINE app #-}@@ -248,14 +238,15 @@ ------------------------------------------------------------------------------------------  -- | Lifting through the 'Monad' and a Reader transformer, where (c,a) is the read-only environment.-instance (Monad m, Monoid b) => Monoid (Transform c m a b) where+instance (Applicative m, Semigroup b) => Semigroup (Transform c m a b) where+   (<>) :: Transform c m a b -> Transform c m a b -> Transform c m a b+   (<>) = liftA2 (<>)+   {-# INLINE (<>) #-} +-- | Lifting through the 'Monad' and a Reader transformer, where (c,a) is the read-only environment.+instance (Monad m, Monoid b) => Monoid (Transform c m a b) where    mempty :: Transform c m a b    mempty = return mempty    {-# INLINE mempty #-}--   mappend :: Transform c m a b -> Transform c m a b -> Transform c m a b-   mappend = liftM2 mappend-   {-# INLINE mappend #-}  ------------------------------------------------------------------------------------------

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -7,10 +6,10 @@ {-# LANGUAGE StandaloneDeriving #-} -- | -- Module: Language.KURE.Walker--- Copyright: (c) 2012--2014 The University of Kansas+-- Copyright: (c) 2012--2021 The University of Kansas -- License: BSD3 ----- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>+-- Maintainer: Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk> -- Stability: beta -- Portability: ghc --@@ -81,19 +80,18 @@ import Prelude hiding (id)  import Data.Maybe (isJust)-import Data.Monoid+import Data.Monoid () import Data.DList (singleton, toList)-#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable-#endif -#if __GLASGOW_HASKELL__ <= 708-import Control.Applicative-#endif import Control.Arrow import Control.Category hiding ((.))-import Control.Monad+import Control.Monad (liftM, ap, mplus) +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+import qualified Control.Monad.Fail+#endif+ import Language.KURE.MonadCatch import Language.KURE.Transform import Language.KURE.Lens@@ -112,7 +110,6 @@ --   but they may be overridden for efficiency.  class Walker c u where-   -- | Apply a rewrite to all immediate children, succeeding if they all succeed.   allR :: MonadCatch m => Rewrite c m u -> Rewrite c m u @@ -142,10 +139,6 @@   childL = childL_default   {-# INLINE childL #-} -#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable Walker-#endif- ------------------------------------------------------------------------------------------  -- | List the children of the current node.@@ -403,7 +396,7 @@ pSnd (P _ b) = b {-# INLINE pSnd #-} -checkSuccessPMaybe :: Monad m => String -> m (Maybe a) -> m a+checkSuccessPMaybe :: MonadFail m => String -> m (Maybe a) -> m a checkSuccessPMaybe msg ma = ma >>= projectWithFailMsgM msg {-# INLINE checkSuccessPMaybe #-} @@ -437,16 +430,23 @@    return a = AllT $ return (P a mempty)    {-# INLINE return #-} -   fail :: String -> AllT w m a-   fail = AllT . fail-   {-# INLINE fail #-}-    (>>=) :: AllT w m a -> (a -> AllT w m d) -> AllT w m d    ma >>= f = AllT $ do P a w1 <- unAllT ma                         P d w2 <- unAllT (f a)                         return (P d (w1 <> w2))    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> AllT w m a+   fail = AllT . fail+   {-# INLINE fail #-}+#endif++instance (Monoid w, MonadFail m) => MonadFail (AllT w m) where+   fail :: String -> AllT w m a+   fail = AllT . fail+   {-# INLINE fail #-}+ instance (Monoid w, MonadCatch m) => MonadCatch (AllT w m) where    catchM :: AllT w m a -> (String -> AllT w m a) -> AllT w m a    catchM (AllT ma) f = AllT $ ma `catchM` (unAllT . f)@@ -495,15 +495,22 @@    return a = OneT $ \ mw -> return (P a mw)    {-# INLINE return #-} -   fail :: String -> OneT w m a-   fail msg = OneT (\ _ -> fail msg)-   {-# INLINE fail #-}-    (>>=) :: OneT w m a -> (a -> OneT w m d) -> OneT w m d    ma >>= f = OneT $ do \ mw1 -> do P a mw2 <- unOneT ma mw1                                     unOneT (f a) mw2    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> OneT w m a+   fail msg = OneT (\ _ -> fail msg)+   {-# INLINE fail #-}+#endif++instance MonadFail m => MonadFail (OneT w m) where+   fail :: String -> OneT w m a+   fail msg = OneT (\ _ -> fail msg)+   {-# INLINE fail #-}+ instance MonadCatch m => MonadCatch (OneT w m) where    catchM :: OneT w m a -> (String -> OneT w m a) -> OneT w m a    catchM (OneT g) f = OneT $ \ mw -> g mw `catchM` (($ mw) . unOneT . f)@@ -518,7 +525,7 @@ {-# INLINE wrapOneT #-}  -- | Unwrap a 'Transform' from the 'OneT' monad transformer.-unwrapOneT :: Monad m => Rewrite c (OneT b m) u -> Transform c m u b+unwrapOneT :: MonadFail m => Rewrite c (OneT b m) u -> Transform c m u b unwrapOneT = resultT (checkSuccessPMaybe "oneT failed" . liftM pSnd . ($ Nothing) . unOneT) {-# INLINE unwrapOneT #-} @@ -555,16 +562,23 @@    return a = GetChild (return a) Nothing    {-# INLINE return #-} -   fail :: String -> GetChild c u a-   fail msg = GetChild (fail msg) Nothing-   {-# INLINE fail #-}-    (>>=) :: GetChild c u a -> (a -> GetChild c u b) -> GetChild c u b    (GetChild kma mcu) >>= k = runKureM (\ a   -> getChildSecond (mplus mcu) (k a))                                        (\ msg -> GetChild (fail msg) mcu)                                        kma    {-# INLINE (>>=) #-} +#if !MIN_VERSION_base(4,13,0)+   fail :: String -> GetChild c u a+   fail msg = GetChild (fail msg) Nothing+   {-# INLINE fail #-}+#endif++instance MonadFail (GetChild c u) where+   fail :: String -> GetChild c u a+   fail msg = GetChild (fail msg) Nothing+   {-# INLINE fail #-}+ instance MonadCatch (GetChild c u) where    catchM :: GetChild c u a -> (String -> GetChild c u a) -> GetChild c u a    uc@(GetChild kma mcu) `catchM` k = runKureM (\ _   -> uc)@@ -595,11 +609,11 @@                        if cr == cr' then return u else idR {-# INLINE wrapSetChild #-} -unwrapSetChild :: Monad m => Rewrite c SetChild u -> Rewrite c m u+unwrapSetChild :: MonadFail m => Rewrite c SetChild u -> Rewrite c m u unwrapSetChild = resultT liftKureM {-# INLINE unwrapSetChild #-} -setChild :: (ReadPath c crumb, Eq crumb, Walker c u, Monad m) => crumb -> u -> Rewrite c m u+setChild :: (ReadPath c crumb, Eq crumb, Walker c u, MonadFail m) => crumb -> u -> Rewrite c m u setChild cr = unwrapSetChild . allR . wrapSetChild cr {-# INLINE setChild #-} 

@@ -1,3 +0,0 @@-# KURE [![Hackage version](https://img.shields.io/hackage/v/kure.svg?style=flat)](http://hackage.haskell.org/package/kure) [![Build Status](https://img.shields.io/travis/ku-fpg/kure.svg?style=flat)](https://travis-ci.org/ku-fpg/kure)--Combinators for Strategic Programming

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE InstanceSigs, MultiParamTypeClasses #-}  module Expr.Context where@@ -7,6 +8,10 @@ import Language.KURE import Language.KURE.ExtendableContext +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+ import Expr.AST  ---------------------------------------------------------------------------@@ -47,7 +52,7 @@ initialContext :: Context initialContext = Context mempty [] -lookupDef :: Monad m => Name -> Context -> m Expr+lookupDef :: MonadFail m => Name -> Context -> m Expr lookupDef v (Context _ defs) = maybe (fail $ v ++ " not found in context") return (lookup v defs)  ---------------------------------------------------------------------------

@@ -1,9 +1,14 @@-{-# LANGUAGE CPP, InstanceSigs, LambdaCase, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE InstanceSigs, LambdaCase, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}  module Expr.Kure where  import Control.Monad +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+ import Language.KURE  import Expr.AST@@ -48,12 +53,12 @@  --------------------------------------------------------------------------- -seqT :: (ExtendPath c Int, AddDef c, Monad m) => Transform c m Cmd a1 -> Transform c m Cmd a2 -> (a1 -> a2 -> b) -> Transform c m Cmd b+seqT :: (ExtendPath c Int, AddDef c, MonadFail m) => Transform c m Cmd a1 -> Transform c m Cmd a2 -> (a1 -> a2 -> b) -> Transform c m Cmd b seqT t1 t2 f = transform $ \ c -> \case                                      Seq cm1 cm2 -> f <$> applyT t1 (c @@ 0) cm1 <*> applyT t2 (updateContextCmd cm1 c @@ 1) cm2                                      _           -> fail "not a Seq" -seqAllR :: (ExtendPath c Int, AddDef c, Monad m) => Rewrite c m Cmd -> Rewrite c m Cmd -> Rewrite c m Cmd+seqAllR :: (ExtendPath c Int, AddDef c, MonadFail m) => Rewrite c m Cmd -> Rewrite c m Cmd -> Rewrite c m Cmd seqAllR r1 r2 = seqT r1 r2 Seq  seqAnyR :: (ExtendPath c Int, AddDef c, MonadCatch m) => Rewrite c m Cmd -> Rewrite c m Cmd -> Rewrite c m Cmd@@ -64,36 +69,36 @@  --------------------------------------------------------------------------- -assignT :: (ExtendPath c Int, Monad m) => Transform c m Expr a -> (Name -> a -> b) -> Transform c m Cmd b+assignT :: (ExtendPath c Int, MonadFail m) => Transform c m Expr a -> (Name -> a -> b) -> Transform c m Cmd b assignT t f = transform $ \ c -> \case                                     Assign n e -> f n <$> applyT t (c @@ 0) e                                     _          -> fail "not an Assign" -assignR :: (ExtendPath c Int, Monad m) => Rewrite c m Expr -> Rewrite c m Cmd+assignR :: (ExtendPath c Int, MonadFail m) => Rewrite c m Expr -> Rewrite c m Cmd assignR r = assignT r Assign  --------------------------------------------------------------------------- -varT :: Monad m => (Name -> b) -> Transform c m Expr b+varT :: MonadFail m => (Name -> b) -> Transform c m Expr b varT f = contextfreeT $ \case                            Var v -> return (f v)                            _     -> fail "not a Var"  --------------------------------------------------------------------------- -litT :: Monad m => (Int -> b) -> Transform c m Expr b+litT :: MonadFail m => (Int -> b) -> Transform c m Expr b litT f = contextfreeT $ \case                            Lit v -> return (f v)                            _     -> fail "not a Lit"  --------------------------------------------------------------------------- -addT :: (ExtendPath c Int, Monad m) => Transform c m Expr a1 -> Transform c m Expr a2 -> (a1 -> a2 -> b) -> Transform c m Expr b+addT :: (ExtendPath c Int, MonadFail m) => Transform c m Expr a1 -> Transform c m Expr a2 -> (a1 -> a2 -> b) -> Transform c m Expr b addT t1 t2 f = transform $ \ c -> \case                                      Add e1 e2 -> f <$> applyT t1 (c @@ 0) e1 <*> applyT t2 (c @@ 1) e2                                      _         -> fail "not an Add" -addAllR :: (ExtendPath c Int, Monad m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr+addAllR :: (ExtendPath c Int, MonadFail m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr addAllR r1 r2 = addT r1 r2 Add  addAnyR :: (ExtendPath c Int, MonadCatch m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr@@ -104,12 +109,12 @@  --------------------------------------------------------------------------- -eseqT :: (ExtendPath c Int, AddDef c, Monad m) => Transform c m Cmd a1 -> Transform c m Expr a2 -> (a1 -> a2 -> b) -> Transform c m Expr b+eseqT :: (ExtendPath c Int, AddDef c, MonadFail m) => Transform c m Cmd a1 -> Transform c m Expr a2 -> (a1 -> a2 -> b) -> Transform c m Expr b eseqT t1 t2 f = transform $ \ c -> \case                                       ESeq cm e1 -> f <$> applyT t1 (c @@ 0) cm <*> applyT t2 (updateContextCmd cm c @@ 1) e1                                       _          -> fail "not an ESeq" -eseqAllR :: (ExtendPath c Int, AddDef c, Monad m) => Rewrite c m Cmd -> Rewrite c m Expr -> Rewrite c m Expr+eseqAllR :: (ExtendPath c Int, AddDef c, MonadFail m) => Rewrite c m Cmd -> Rewrite c m Expr -> Rewrite c m Expr eseqAllR r1 r2 = eseqT r1 r2 ESeq  eseqAnyR :: (ExtendPath c Int, AddDef c, MonadCatch m) => Rewrite c m Cmd -> Rewrite c m Expr -> Rewrite c m Expr@@ -117,17 +122,5 @@  eseqOneR :: (ExtendPath c Int, AddDef c, MonadCatch m) => Rewrite c m Cmd -> Rewrite c m Expr -> Rewrite c m Expr eseqOneR r1 r2 = unwrapOneR $ eseqAllR (wrapOneR r1) (wrapOneR r2)-------------------------------------------------------------------------------#if __GLASGOW_HASKELL__ <= 708-(<$>) :: Monad m => (a -> b) -> m a -> m b-(<$>) = liftM-{-# INLINE (<$>) #-}--(<*>) :: Monad m => m (a -> b) -> m a -> m b-(<*>) = ap-{-# INLINE (<*>) #-}-#endif  ---------------------------------------------------------------------------

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, InstanceSigs, LambdaCase, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE InstanceSigs, LambdaCase, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}  module Fib.Kure (Crumb(..)) where @@ -22,17 +22,5 @@                          Add e0 e1  ->  Add <$> applyR r (c @@ LeftChild) e0 <*> applyR r (c @@ RightChild) e1                          Sub e0 e1  ->  Sub <$> applyR r (c @@ LeftChild) e0 <*> applyR r (c @@ RightChild) e1                          Fib e0     ->  Fib <$> applyR r (c @@ OnlyChild) e0------------------------------------------------------------------------------------------#if __GLASGOW_HASKELL__ <= 708-(<$>) :: Monad m => (a -> b) -> m a -> m b-(<$>) = liftM-{-# INLINE (<$>) #-}--(<*>) :: Monad m => m (a -> b) -> m a -> m b-(<*>) = ap-{-# INLINE (<*>) #-}-#endif  --------------------------------------------------------------------------------------

@@ -82,7 +82,7 @@                   return f  -- This might not actually be normal order evaluation--- Contact the  KURE maintainer if you can correct this definition.+-- Contact the KURE maintainer if you can correct this definition. normal_order_eval :: RewriteE normal_order_eval = anytdR (repeatR beta_reduce) 

@@ -1,9 +1,14 @@-{-# LANGUAGE CPP, InstanceSigs, LambdaCase, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE InstanceSigs, LambdaCase, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-}  module Lam.Kure where  import Control.Monad +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+ import Language.KURE  import Lam.AST@@ -24,29 +29,29 @@ -- | Congruence combinators. --   Using these ensures that the context is updated consistantly. -varT :: Monad m => (Name -> b) -> Transform c m Exp b+varT :: MonadFail m => (Name -> b) -> Transform c m Exp b varT f = contextfreeT $ \case                            Var n -> return (f n)                            _     -> fail "no match for Var"  ------------------------------------------------------------------------------- -lamT :: (ExtendPath c Crumb, AddBoundVar c, Monad m) => Transform c m Exp a -> (Name -> a -> b) -> Transform c m Exp b+lamT :: (ExtendPath c Crumb, AddBoundVar c, MonadFail m) => Transform c m Exp a -> (Name -> a -> b) -> Transform c m Exp b lamT t f = transform $ \ c -> \case                                  Lam v e -> f v <$> applyT t (addBoundVar v c @@ Lam_Body) e                                  _       -> fail "no match for Lam" -lamR :: (ExtendPath c Crumb, AddBoundVar c, Monad m) => Rewrite c m Exp -> Rewrite c m Exp+lamR :: (ExtendPath c Crumb, AddBoundVar c, MonadFail m) => Rewrite c m Exp -> Rewrite c m Exp lamR r = lamT r Lam  ------------------------------------------------------------------------------- -appT :: (ExtendPath c Crumb, Monad m) => Transform c m Exp a1 -> Transform c m Exp a2 -> (a1 -> a2 -> b) -> Transform c m Exp b+appT :: (ExtendPath c Crumb, MonadFail m) => Transform c m Exp a1 -> Transform c m Exp a2 -> (a1 -> a2 -> b) -> Transform c m Exp b appT t1 t2 f = transform $ \ c -> \case                                      App e1 e2 -> f <$> applyT t1 (c @@ App_Fun) e1 <*> applyT t2 (c @@ App_Arg) e2                                      _         -> fail "no match for App" -appAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp+appAllR :: (ExtendPath c Crumb, MonadFail m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp appAllR r1 r2 = appT r1 r2 App  appAnyR :: (ExtendPath c Crumb, MonadCatch m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp@@ -54,17 +59,5 @@  appOneR :: (ExtendPath c Crumb, MonadCatch m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp appOneR r1 r2 = unwrapOneR $ appAllR (wrapOneR r1) (wrapOneR r2)-----------------------------------------------------------------------------------#if __GLASGOW_HASKELL__ <= 708-(<$>) :: Monad m => (a -> b) -> m a -> m b-(<$>) = liftM-{-# INLINE (<$>) #-}--(<*>) :: Monad m => m (a -> b) -> m a -> m b-(<*>) = ap-{-# INLINE (<*>) #-}-#endif  -------------------------------------------------------------------------------

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# Language InstanceSigs #-}  module Lam.Monad where@@ -7,6 +8,10 @@ import Control.Applicative import Control.Monad +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail+#endif+ -------------------------------------------------------------------------------  newtype LamM a = LamM {lamM :: Int -> (Int, Either String a)}@@ -18,16 +23,21 @@   return :: a -> LamM a   return a = LamM (\n -> (n,Right a)) -  fail :: String -> LamM a-  fail msg = LamM (\ n -> (n, Left msg))-   (>>=) :: LamM a -> (a -> LamM b) -> LamM b   (LamM f) >>= gg = LamM $ \ n -> case f n of                                     (n', Left msg) -> (n', Left msg)                                     (n', Right a)  -> lamM (gg a) n' -instance MonadCatch LamM where+#if !MIN_VERSION_base(4,13,0)+  fail :: String -> LamM a+  fail msg = LamM (\ n -> (n, Left msg))+#endif +instance MonadFail LamM where+  fail :: String -> LamM a+  fail msg = LamM (\ n -> (n, Left msg))++instance MonadCatch LamM where   catchM :: LamM a -> (String -> LamM a) -> LamM a   (LamM st) `catchM` f = LamM $ \ n -> case st n of                                         (n', Left msg) -> lamM (f msg) n'

@@ -1,8 +1,8 @@ Name:                kure-Version:             2.16.12+Version:             2.18.6 Synopsis:            Combinators for Strategic Programming-Description:	     The Kansas University Rewrite Engine (KURE) is a domain-specific language for strategic rewriting.-	 	     KURE was inspired by Stratego and StrategyLib, and has similarities with Scrap Your Boilerplate and Uniplate.+Description:         The Kansas University Rewrite Engine (KURE) is a domain-specific language for strategic rewriting.+                     KURE was inspired by Stratego and StrategyLib, and has similarities with Scrap Your Boilerplate and Uniplate.                      .                      The basic transformation functionality can be found in "Language.KURE.Transform",                      and the traversal functionality can be found in "Language.KURE.Walker".@@ -12,20 +12,19 @@                      You can read about KURE in the following article:                      .                      The Kansas University Rewrite Engine: A Haskell-Embedded Strategic Programming Language with Custom Closed Universes.  Neil Sculthorpe, Nicolas Frisby and Andy Gill.  Journal of Functional Programming.  Cambridge University Press, 24(4), pages 434-473, 2014.-                     <http://www.cs.swan.ac.uk/~csnas/papers_and_talks/kure.pdf>+                     <https://dx.doi.org/10.1017/S0956796814000185>  Category:            Language License:             BSD3 License-file:        LICENSE Author:              Neil Sculthorpe and Andy Gill-Maintainer:          Neil Sculthorpe <N.A.Sculthorpe@swansea.ac.uk>-Copyright:           (c) 2006--2015 The University of Kansas-Homepage:            http://www.ittc.ku.edu/csdl/fpg/software/kure.html-Stability:	     beta-build-type: 	     Simple-Cabal-Version:       >= 1.10+Maintainer:          Neil Sculthorpe <neil.sculthorpe@ntu.ac.uk>+Copyright:           (c) 2006--2021 The University of Kansas+Homepage:            https://ku-fpg.github.io/software/kure/+Stability:           beta+build-type:          Simple+Cabal-Version:       1.16 Extra-Source-Files:-    README.md     CHANGELOG.md     examples/Examples.hs     examples/Fib/AST.hs@@ -43,9 +42,9 @@  Library   Build-Depends:-       base         >= 4.5 && < 5,-       dlist        >= 0.2 && < 1,-       transformers >= 0.2 && < 1+       base         >= 4.8   && < 5,+       dlist        >= 0.6   && < 1,+       transformers >= 0.4.1 && < 1   default-language: Haskell2010   Ghc-Options: -Wall   Exposed-modules: