gistfile1.hs

{-# LANGUAGE FlexibleInstances #-}
import Database.Persist
import Control.Monad.Trans.Error
import Control.Monad.Trans.Class
import Data.Enumerator

newtype OcrError = OE String

instance Error OcrError

instance PersistBackend m => PersistBackend (ErrorT OcrError m) where
 replace      k v = lift $ replace     k v
 update       k l = lift $ update      k l
 updateWhere  f u = lift $ updateWhere f u
 delete       = lift . delete
 insert       = lift . insert
 deleteBy     = lift . deleteBy
 deleteWhere  = lift . deleteWhere
 get          = lift . get
 getBy        = lift . getBy
 count        = lift . count
 selectKeys a e = go e $ selectKeys a
 selectEnum a b c d e = go e $ selectEnum a b c d

{-
selectEnum' :: ([Filter val] -> [Order val] -> Int -> Int -> Enumerator In IO (Either OcrError Out))
            -> [Filter val] -> [Order val] -> Int -> Int
            -> Enumerator In (ErrorT OcrError IO) Out
-}
selectEnum' inner a b c d e =
    go e $ inner a b c d

{-
go :: Step In (ErrorT OcrError IO) Out
   -> (Step In IO (Either OcrError Out)
   -> Iteratee In IO (Either OcrError Out))
   -> Iteratee In (ErrorT OcrError IO) Out
-}
go step enum = unpeel $ enum $ peel step

--peel :: Step In (ErrorT e IO) Out -> Step In IO (Either e Out)
peel (Yield b s) = Yield (Right b) s
peel (Error e) = Error e
peel (Continue k) = Continue $ \s -> Iteratee $ do
    x <- runErrorT $ runIteratee $ k s
    case x of
        Left e -> return $ Yield (Left e) EOF
        Right x -> return $ peel x

data In = In
data Out = Out

{-
unpeel :: Iteratee In IO (Either OcrError Out)
       -> Iteratee In (ErrorT OcrError IO) Out
-}
unpeel (Iteratee mstep) = Iteratee $ do
    step <- lift mstep
    go' step

{-
go' :: Step In IO (Either OcrError Out)
    -> ErrorT OcrError IO (Step In (ErrorT OcrError IO) Out)
-}
go' (Yield (Left e) _) = ErrorT $ return $ Left e
go' (Yield (Right b) s) = ErrorT $ return $ Right $ Yield b s
go' (Error e) = return $ Error e
go' (Continue k) = ErrorT $ return $ Right $ Continue $ \s -> Iteratee $ do
    step <- lift $ runIteratee $ k s
    go' step