back to exceptT

katydid.cabal

@@ -1,5 +1,5 @@
 name:                katydid
-version:             0.3.0.1
+version:             0.3.1.0
 synopsis:            A haskell implementation of Katydid
 description:         
   A haskell implementation of Katydid
@@ -66,7 +66,7 @@ library
                      , either
                      , extra
                      , ilist
-                     , transformers-either
+                     , transformers
   default-language:    Haskell2010
 
 executable katydid-exe

src/MemDerive.hs

@@ -13,7 +13,7 @@ module MemDerive (
 
 import qualified Data.Map.Strict as M
 import Control.Monad.State (State, runState, lift, state)
-import Control.Monad.Trans.Either (EitherT, runEitherT, left, hoistEither)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 
 import qualified Derive
 import Smart (Grammar, Pattern, lookupRef, nullable, lookupMain)
@@ -49,11 +49,11 @@ returns :: Grammar -> ([Pattern], [Bool]) -> State Mem [Pattern]
 returns g k = state $ \(Mem (c, r)) -> let (v', r') = mem (Derive.returns g) k r;
     in (v', Mem (c, r'))
 
-mderive :: Tree t => Grammar -> [Pattern] -> [t] -> EitherT String (State Mem) [Pattern]
+mderive :: Tree t => Grammar -> [Pattern] -> [t] -> ExceptT String (State Mem) [Pattern]
 mderive _ ps [] = return ps
 mderive g ps (tree:ts) = do {
     ifs <- lift $ calls g ps;
-    childps <- hoistEither $ evalIfExprs ifs (getLabel tree);
+    childps <- hoistExcept $ evalIfExprs ifs (getLabel tree);
     (zchildps, zipper) <- return $ zippy childps;
     childres <- mderive g zchildps (getChildren tree);
     let 
@@ -64,12 +64,15 @@ mderive g ps (tree:ts) = do {
     mderive g rs ts
 }
 
+hoistExcept :: (Monad m) => Either e a -> ExceptT e m a
+hoistExcept = ExceptT . return
+
 -- |
 -- derive is the classic derivative implementation for trees.
 derive :: Tree t => Grammar -> [t] -> Either String Pattern
 derive g ts =
     let start = [lookupMain g]
-        (res, _) = runState (runEitherT $ mderive g start ts) newMem
+        (res, _) = runState (runExceptT $ mderive g start ts) newMem
     in case res of
         (Left l) -> Left l
         (Right [r]) -> return r
@@ -80,7 +83,7 @@ derive g ts =
 -- return whether tree is valid, given the input grammar and start pattern.
 validate :: Tree t => Grammar -> Pattern -> [t] -> (State Mem) Bool
 validate g start tree = do {
-    rs <- runEitherT (mderive g [start] tree);
+    rs <- runExceptT (mderive g [start] tree);
     return $ case rs of
         (Right [r]) -> nullable r
         _ -> False

src/VpaDerive.hs

@@ -12,7 +12,7 @@ module VpaDerive (
 import qualified Data.Map.Strict as M
 import Control.Monad.State (State, runState, state, lift)
 import Data.Foldable (foldlM)
-import Control.Monad.Trans.Either (EitherT, runEitherT, left, hoistEither)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 
 import qualified Derive
 import Smart (Grammar, Pattern)
@@ -48,16 +48,19 @@ calls :: [Pattern] -> State Vpa ZippedIfExprs
 calls key = state $ \(Vpa (n, c, r, g)) -> let (v', c') = mem (zipIfExprs . Derive.calls g) key c;
     in (v', Vpa (n, c', r, g))
 
-vpacall :: VpaState -> Label -> EitherT String (State Vpa) (StackElm, VpaState)
+vpacall :: VpaState -> Label -> ExceptT String (State Vpa) (StackElm, VpaState)
 vpacall vpastate label = do {
     zifexprs <- lift $ calls vpastate;
-    (nextstate, zipper) <- hoistEither $ evalZippedIfExprs zifexprs label;
+    (nextstate, zipper) <- hoistExcept $ evalZippedIfExprs zifexprs label;
     let 
         stackelm = (vpastate, zipper)
     ; 
     return (stackelm, nextstate)
 }
 
+hoistExcept :: (Monad m) => Either e a -> ExceptT e m a
+hoistExcept = ExceptT . return
+
 returns :: ([Pattern], Zipper, [Bool]) -> State Vpa [Pattern]
 returns key = state $ \(Vpa (n, c, r, g)) -> 
     let (v', r') = mem (\(ps, zipper, znulls) -> 
@@ -70,7 +73,7 @@ vpareturn (vpastate, zipper) current = do {
     returns (vpastate, zipper, zipnulls)
 }
 
-deriv :: Tree t => VpaState -> t -> EitherT String (State Vpa) VpaState
+deriv :: Tree t => VpaState -> t -> ExceptT String (State Vpa) VpaState
 deriv current tree = do {
     (stackelm, nextstate) <- vpacall current (getLabel tree);
     resstate <- foldlM deriv nextstate (getChildren tree);
@@ -80,7 +83,7 @@ deriv current tree = do {
 foldLT :: Tree t => Vpa -> VpaState -> [t] -> Either String [Pattern]
 foldLT _ current [] = return current
 foldLT m current (t:ts) = 
-    let (newstate, newm) = runState (runEitherT $ deriv current t) m
+    let (newstate, newm) = runState (runExceptT $ deriv current t) m
     in case newstate of
         (Left l) -> Left l
         (Right r) -> foldLT newm r ts

stack.yaml

@@ -15,7 +15,7 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: nightly-2018-05-06
+resolver: nightly-2018-05-14
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.