module Darcs.Test.Patch.RepoModel where import Darcs.Patch.Apply ( Apply, ApplyState ) import Darcs.Patch.Witnesses.Ordered ( FL ) import Control.Monad.Fail ( MonadFail(fail) ) import Test.QuickCheck ( Gen ) data Fail a = Failed String | OK a deriving (Eq, Show) instance Functor Fail where fmap _ (Failed s) = Failed s fmap f (OK v) = OK (f v) instance Applicative Fail where pure = OK Failed s <*> _ = Failed s _ <*> Failed s = Failed s OK f <*> OK v = OK (f v) instance Monad Fail where return = OK Failed s >>= _ = Failed s OK v >>= f = f v instance MonadFail Fail where fail = Failed unFail :: Fail t -> t unFail (OK x) = x unFail (Failed err) = error $ "unFail failed: " ++ err maybeFail :: Fail a -> Maybe a maybeFail (OK x) = Just x maybeFail _ = Nothing class RepoModel model where type RepoState model :: (* -> *) -> * showModel :: model x -> String eqModel :: model x -> model x -> Bool aSmallRepo :: Gen (model x) repoApply :: (Apply p, ApplyState p ~ RepoState model) => model x -> p x y -> Fail (model y) type family ModelOf (patch :: * -> * -> *) :: * -> * type instance ModelOf (FL prim) = ModelOf prim