----------------------------------------------------------------------
-- |
-- Module      : Operations
-- Maintainer  : AR
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/11/11 16:12:41 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.22 $
--
-- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001
--
-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL)
-----------------------------------------------------------------------------

module GF.Data.Operations (
     -- ** The Error monad
     Err(..), err, maybeErr, testErr, fromErr, errIn,
     lookupErr,

     -- ** Error monad class
     ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
                 liftErr,

     -- ** Checking
     checkUnique, unifyMaybeBy, unifyMaybe,

         -- ** Monadic operations on lists and pairs
     mapPairsM, pairM,

     -- ** Printing
     indent, (+++), (++-), (++++), (+++-), (+++++),
     prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
     prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
     numberedParagraphs, prConjList, prIfEmpty, wrapLines,

     -- ** Topological sorting
     topoTest, topoTest2,

     -- ** Misc
     readIntArg,
     iterFix,  chunks,

    ) where

import Data.Char (isSpace, toUpper, isSpace, isDigit)
import Data.List (nub, partition, (\\))
import qualified Data.Map as Map
import Data.Map (Map)
--import Control.Applicative(Applicative(..))
import Control.Monad (liftM,liftM2) --,ap

import GF.Data.ErrM
import GF.Data.Relation
import qualified Control.Monad.Fail as Fail

infixr 5 +++
infixr 5 ++-
infixr 5 ++++
infixr 5 +++++

-- the Error monad

-- | Add msg s to 'Maybe' failures
maybeErr :: ErrorMonad m => String -> Maybe a -> m a
maybeErr :: String -> Maybe a -> m a
maybeErr String
s = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise String
s) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

testErr :: ErrorMonad m => Bool -> String -> m ()
testErr :: Bool -> String -> m ()
testErr Bool
cond String
msg = if Bool
cond then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> m ()
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise String
msg

errIn :: ErrorMonad m => String -> m a -> m a
errIn :: String -> m a -> m a
errIn String
msg m a
m = m a -> (String -> m a) -> m a
forall (m :: * -> *) a.
ErrorMonad m =>
m a -> (String -> m a) -> m a
handle m a
m (\String
s -> String -> m a
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise (String
s String -> String -> String
++++ String
"OCCURRED IN" String -> String -> String
++++ String
msg))

lookupErr :: (ErrorMonad m,Eq a,Show a) => a -> [(a,b)] -> m b
lookupErr :: a -> [(a, b)] -> m b
lookupErr a
a [(a, b)]
abs = String -> Maybe b -> m b
forall (m :: * -> *) a. ErrorMonad m => String -> Maybe a -> m a
maybeErr (String
"Unknown" String -> String -> String
+++ a -> String
forall a. Show a => a -> String
show a
a) (a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
a [(a, b)]
abs)

mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
mapPairsM :: (b -> m c) -> [(a, b)] -> m [(a, c)]
mapPairsM b -> m c
f [(a, b)]
xys = ((a, b) -> m (a, c)) -> [(a, b)] -> m [(a, c)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ (a
x,b
y) -> (c -> (a, c)) -> m c -> m (a, c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) a
x) (b -> m c
f b
y)) [(a, b)]
xys

pairM :: Monad m => (b -> m c) -> (b,b) -> m (c,c)
pairM :: (b -> m c) -> (b, b) -> m (c, c)
pairM b -> m c
op (b
t1,b
t2) = (c -> c -> (c, c)) -> m c -> m c -> m (c, c)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (b -> m c
op b
t1) (b -> m c
op b
t2)

-- checking

checkUnique :: (Show a, Eq a) => [a] -> [String]
checkUnique :: [a] -> [String]
checkUnique [a]
ss = [String
"overloaded" String -> String -> String
+++ a -> String
forall a. Show a => a -> String
show a
s | a
s <- [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
overloads] where
  overloads :: [a]
overloads = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
overloaded [a]
ss
  overloaded :: a -> Bool
overloaded a
s = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
s) [a]
ss) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1

-- | this is what happens when matching two values in the same module
unifyMaybe :: (Eq a, Fail.MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
unifyMaybe :: Maybe a -> Maybe a -> m (Maybe a)
unifyMaybe = (a -> a) -> Maybe a -> Maybe a -> m (Maybe a)
forall b (m :: * -> *) a.
(Eq b, MonadFail m) =>
(a -> b) -> Maybe a -> Maybe a -> m (Maybe a)
unifyMaybeBy a -> a
forall a. a -> a
id

unifyMaybeBy :: (Eq b, Fail.MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
unifyMaybeBy :: (a -> b) -> Maybe a -> Maybe a -> m (Maybe a)
unifyMaybeBy a -> b
f (Just a
p1) (Just a
p2)
  | a -> b
f a
p1b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==a -> b
f a
p2                     = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
p1)
  | Bool
otherwise                      = String -> m (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
unifyMaybeBy a -> b
_ Maybe a
Nothing   Maybe a
mp2       = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mp2
unifyMaybeBy a -> b
_ Maybe a
mp1       Maybe a
_         = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mp1

-- printing

indent :: Int -> String -> String
indent :: Int -> String -> String
indent Int
i String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

(+++), (++-), (++++), (+++-), (+++++) :: String -> String -> String
String
a +++ :: String -> String -> String
+++ String
b   = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b

String
a ++- :: String -> String -> String
++- String
""  = String
a
String
a ++- String
b   = String
a String -> String -> String
+++ String
b

String
a ++++ :: String -> String -> String
++++ String
b  = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b

String
a +++- :: String -> String -> String
+++- String
"" = String
a
String
a +++- String
b  = String
a String -> String -> String
++++ String
b

String
a +++++ :: String -> String -> String
+++++ String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b


prUpper :: String -> String
prUpper :: String -> String
prUpper String
s = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2' where
 (String
s1,String
s2) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s
 s2' :: String
s2' = case String
s2 of
   Char
c:String
t -> Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
t
   String
_ -> String
s2

prReplicate :: Int -> String -> String
prReplicate :: Int -> String -> String
prReplicate Int
n String
s = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n String
s)

prTList :: String -> [String] -> String
prTList :: String -> [String] -> String
prTList String
t [String]
ss = case [String]
ss of
  []   -> String
""
  [String
s]  -> String
s
  String
s:[String]
ss -> String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
prTList String
t [String]
ss

prQuotedString :: String -> String
prQuotedString :: String -> String
prQuotedString String
x = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
restoreEscapes String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

prParenth :: String -> String
prParenth :: String -> String
prParenth String
s = if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

prCurly, prBracket :: String -> String
prCurly :: String -> String
prCurly   String
s = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
prBracket :: String -> String
prBracket String
s = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

prArgList, prSemicList, prCurlyList :: [String] -> String
prArgList :: [String] -> String
prArgList   = String -> String
prParenth (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
prTList String
","
prSemicList :: [String] -> String
prSemicList = String -> [String] -> String
prTList String
" ; "
prCurlyList :: [String] -> String
prCurlyList = String -> String
prCurly (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
prSemicList

restoreEscapes :: String -> String
restoreEscapes :: String -> String
restoreEscapes String
s =
  case String
s of
    []       -> []
    Char
'"' : String
t  -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"'  Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
restoreEscapes String
t
    Char
'\\': String
t  -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
restoreEscapes String
t
    Char
c   : String
t  -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
restoreEscapes String
t

numberedParagraphs :: [[String]] -> [String]
numberedParagraphs :: [[String]] -> [String]
numberedParagraphs [[String]]
t = case [[String]]
t of
  []   -> []
  [String]
p:[] -> [String]
p
  [[String]]
_    -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
s | (Integer
n,[String]
s) <- [Integer] -> [[String]] -> [(Integer, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [[String]]
t]

prConjList :: String -> [String] -> String
prConjList :: String -> [String] -> String
prConjList String
c []     = String
""
prConjList String
c [String
s]    = String
s
prConjList String
c [String
s,String
t]  = String
s String -> String -> String
+++ String
c String -> String -> String
+++ String
t
prConjList String
c (String
s:[String]
tt) = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
+++ String -> [String] -> String
prConjList String
c [String]
tt

prIfEmpty :: String -> String -> String -> String -> String
prIfEmpty :: String -> String -> String -> String -> String
prIfEmpty String
em String
_    String
_    [] = String
em
prIfEmpty String
em String
nem1 String
nem2 String
s  = String
nem1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nem2

-- | Thomas Hallgren's wrap lines
wrapLines :: Int -> String -> String
wrapLines :: Int -> String -> String
wrapLines Int
n String
"" = String
""
wrapLines Int
n s :: String
s@(Char
c:String
cs) =
      if Char -> Bool
isSpace Char
c
      then Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
wrapLines (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
cs
      else case ReadS String
lex String
s of
            [(String
w,String
rest)] -> if Int
n'Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
76
                          then Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
wrapLines Int
l String
rest
                          else String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
wrapLines Int
n' String
rest
               where n' :: Int
n' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l
                     l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w
            [(String, String)]
_ -> String
s -- give up!!

-- | Topological sorting with test of cyclicity
topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]
topoTest :: [(a, [a])] -> Either [a] [[a]]
topoTest = Rel a -> Either [a] [[a]]
forall a. Ord a => Rel a -> Either [a] [[a]]
topologicalSort (Rel a -> Either [a] [[a]])
-> ([(a, [a])] -> Rel a) -> [(a, [a])] -> Either [a] [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, [a])] -> Rel a
forall a. Ord a => [(a, [a])] -> Rel a
mkRel'

-- | Topological sorting with test of cyclicity, new version /TH 2012-06-26
topoTest2 :: Ord a => [(a,[a])] -> Either [[a]] [[a]]
topoTest2 :: [(a, [a])] -> Either [[a]] [[a]]
topoTest2 [(a, [a])]
g0 = Either [[a]] [[a]]
-> ([[a]] -> Either [[a]] [[a]])
-> Maybe [[a]]
-> Either [[a]] [[a]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[a]] -> Either [[a]] [[a]]
forall a b. b -> Either a b
Right [[a]]
cycles) [[a]] -> Either [[a]] [[a]]
forall a b. a -> Either a b
Left ([(a, [a])] -> Maybe [[a]]
forall a. Eq a => [(a, [a])] -> Maybe [[a]]
tsort [(a, [a])]
g)
  where
    g :: [(a, [a])]
g = [(a, [a])]
g0[(a, [a])] -> [(a, [a])] -> [(a, [a])]
forall a. [a] -> [a] -> [a]
++[(a
n,[])|a
n<-[a] -> [a]
forall a. Eq a => [a] -> [a]
nub (((a, [a]) -> [a]) -> [(a, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [a]) -> [a]
forall a b. (a, b) -> b
snd [(a, [a])]
g0)[a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\((a, [a]) -> a) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> a
forall a b. (a, b) -> a
fst [(a, [a])]
g0]

    cycles :: [[a]]
cycles = Rel a -> [[a]]
forall a. Ord a => Rel a -> [[a]]
findCycles ([(a, [a])] -> Rel a
forall a. Ord a => [(a, [a])] -> Rel a
mkRel' [(a, [a])]
g)

    tsort :: [(a, [a])] -> Maybe [[a]]
tsort [(a, [a])]
nes =
      case ((a, [a]) -> Bool) -> [(a, [a])] -> ([(a, [a])], [(a, [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([a] -> Bool) -> ((a, [a]) -> [a]) -> (a, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, [a]) -> [a]
forall a b. (a, b) -> b
snd) [(a, [a])]
nes of
        ([],[]) -> [[a]] -> Maybe [[a]]
forall a. a -> Maybe a
Just []
        ([],[(a, [a])]
_) -> Maybe [[a]]
forall a. Maybe a
Nothing
        ([(a, [a])]
ns,[(a, [a])]
rest) -> ([a]
leaves[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> Maybe [[a]] -> Maybe [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [(a, [a])] -> Maybe [[a]]
tsort [(a
n,[a]
es [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
leaves) | (a
n,[a]
es)<-[(a, [a])]
rest]
            where leaves :: [a]
leaves = ((a, [a]) -> a) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> a
forall a b. (a, b) -> a
fst [(a, [a])]
ns


-- | Fix point iterator (for computing e.g. transitive closures or reachability)
iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
iterFix :: ([a] -> [a]) -> [a] -> [a]
iterFix [a] -> [a]
more [a]
start = [a] -> [a] -> [a]
iter [a]
start [a]
start
  where
    iter :: [a] -> [a] -> [a]
iter [a]
old [a]
new = if ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
new')
                      then [a]
old
                      else [a] -> [a] -> [a]
iter ([a]
new' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
old) [a]
new'
      where
        new' :: [a]
new' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
old) ([a] -> [a]
more [a]
new)

-- | chop into separator-separated parts
chunks :: Eq a => a -> [a] -> [[a]]
chunks :: a -> [a] -> [[a]]
chunks a
sep [a]
ws = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
sep) [a]
ws of
  ([a]
a,a
_:[a]
b) -> [a]
a [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
bs where bs :: [[a]]
bs = a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
chunks a
sep [a]
b
  ([a]
a, []) -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a then [] else [[a]
a]

readIntArg :: String -> Int
readIntArg :: String -> Int
readIntArg String
n = if (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
n) then String -> Int
forall a. Read a => String -> a
read String
n else Int
0

class (Functor m,Monad m) => ErrorMonad m where
  raise   :: String -> m a
  handle  :: m a -> (String -> m a) -> m a
  handle_ :: m a -> m a -> m a
  handle_ m a
a m a
b =  m a
a m a -> (String -> m a) -> m a
forall (m :: * -> *) a.
ErrorMonad m =>
m a -> (String -> m a) -> m a
`handle` (\String
_ -> m a
b)

instance ErrorMonad Err where
  raise :: String -> Err a
raise  = String -> Err a
forall a. String -> Err a
Bad
  handle :: Err a -> (String -> Err a) -> Err a
handle a :: Err a
a@(Ok a
_) String -> Err a
_ = Err a
a
  handle (Bad String
i) String -> Err a
f  = String -> Err a
f String
i

liftErr :: Err a -> m a
liftErr Err a
e = (String -> m a) -> (a -> m a) -> Err a -> m a
forall b a. (String -> b) -> (a -> b) -> Err a -> b
err String -> m a
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Err a
e
{-
instance ErrorMonad (STM s) where
  raise msg = STM (\s -> raise msg)
  handle (STM f) g = STM (\s -> (f s)
                                `handle` (\e -> let STM g' = (g e) in
                                                    g' s))

-}

-- | if the first check fails try another one
checkAgain :: ErrorMonad m => m a -> m a -> m a
checkAgain :: m a -> m a -> m a
checkAgain m a
c1 m a
c2 = m a -> m a -> m a
forall (m :: * -> *) a. ErrorMonad m => m a -> m a -> m a
handle_ m a
c1 m a
c2

checks :: ErrorMonad m => [m a] -> m a
checks :: [m a] -> m a
checks [] = String -> m a
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise String
"no chance to pass"
checks [m a]
cs = (m a -> m a -> m a) -> [m a] -> m a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 m a -> m a -> m a
forall (m :: * -> *) a. ErrorMonad m => m a -> m a -> m a
checkAgain [m a]
cs
{-
allChecks :: ErrorMonad m => [m a] -> m [a]
allChecks ms = case ms of
  (m: ms) -> let rs = allChecks ms in handle_ (liftM2 (:) m rs) rs
  _ -> return []

doUntil :: ErrorMonad m => (a -> Bool) -> [m a] -> m a
doUntil cond ms = case ms of
  a:as -> do
    v <- a
    if cond v then return v else doUntil cond as
  _ -> raise "no result"
-}