module Language.KURE.BiTransform
(
BiTransform, BiTranslate
, BiRewrite
, bidirectional
, forwardT
, backwardT
, whicheverR
, invertBiT
, beforeBiR
, afterBiR
, extractBiT
, promoteBiT
, extractBiR
, promoteBiR
, extractWithFailMsgBiT
, promoteWithFailMsgBiT
, extractWithFailMsgBiR
, promoteWithFailMsgBiR
) where
import Prelude hiding (id, (.))
import Control.Category
import Language.KURE.MonadCatch
import Language.KURE.Transform
import Language.KURE.Injection
data BiTransform c m a b = BiTransform {forwardT :: Transform c m a b,
backwardT :: Transform c m b a
}
type BiTranslate c m a b = BiTransform c m a b
type BiRewrite c m a = BiTransform c m a a
bidirectional :: Transform c m a b -> Transform c m b a -> BiTransform c m a b
bidirectional = BiTransform
whicheverR :: MonadCatch m => BiRewrite c m a -> Rewrite c m a
whicheverR r = forwardT r <+ backwardT r
invertBiT :: BiTransform c m a b -> BiTransform c m b a
invertBiT (BiTransform t1 t2) = BiTransform t2 t1
instance Monad m => Category (BiTransform c m) where
id :: BiTransform c m a a
id = bidirectional id id
(.) :: BiTransform c m b d -> BiTransform c m a b -> BiTransform c m a d
(BiTransform f1 b1) . (BiTransform f2 b2) = BiTransform (f1 . f2) (b2 . b1)
beforeBiR :: Monad m => Transform c m a b -> (b -> BiRewrite c m a) -> BiRewrite c m a
beforeBiR t f = bidirectional (t >>= (forwardT . f)) (t >>= (backwardT . f))
afterBiR :: Monad m => BiRewrite c m a -> Rewrite c m a -> BiRewrite c m a
afterBiR b rr = bidirectional (forwardT b >>> rr) (backwardT b >>> rr)
extractWithFailMsgBiT :: (Monad 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)
extractBiT :: (Monad m, Injection a u, Injection b u) => BiTransform c m u u -> BiTransform c m a b
extractBiT = extractWithFailMsgBiT "extractBiT failed"
promoteWithFailMsgBiT :: (Monad 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)
promoteBiT :: (Monad m, Injection a u, Injection b u) => BiTransform c m a b -> BiTransform c m u u
promoteBiT = promoteWithFailMsgBiT "promoteBiT failed"
extractWithFailMsgBiR :: (Monad 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)
extractBiR :: (Monad m, Injection a u) => BiRewrite c m u -> BiRewrite c m a
extractBiR = extractWithFailMsgBiR "extractBiR failed"
promoteWithFailMsgBiR :: (Monad 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)
promoteBiR :: (Monad m, Injection a u) => BiRewrite c m a -> BiRewrite c m u
promoteBiR = promoteWithFailMsgBiR "promoteBiR failed"