module Precis.Utils.Common
(
H
, emptyH
, wrapH
, consH
, snocH
, appendH
, veloH
, concatH
, toListH
, fromListH
, unlist
, mapLeft
, mapRight
, onSuccessM
, pstar
, pstar2
, star
, star2
) where
import Control.Monad
type H a = [a] -> [a]
infixr 2 `snocH`
emptyH :: H a
emptyH = id
wrapH :: a -> H a
wrapH a = consH a id
consH :: a -> H a -> H a
consH a f = (a:) . f
snocH :: H a -> a -> H a
snocH f a = f . (a:)
appendH :: H a -> H a -> H a
appendH f g = f . g
veloH :: (a -> b) -> [a] -> H b
veloH _ [] = id
veloH f (x:xs) = consH (f x) $ veloH f xs
concatH :: [H a] -> H a
concatH = foldr (.) id
toListH :: H a -> [a]
toListH = ($ [])
fromListH :: [a] -> H a
fromListH [] = id
fromListH xs = (xs++)
unlist :: [String] -> String
unlist [] = ""
unlist [w] = w
unlist (w:ws) = w ++ ',' : ' ' : unwords ws
mapLeft :: (a -> s) -> Either a b -> Either s b
mapLeft f (Left a) = Left $ f a
mapLeft _ (Right b) = Right b
mapRight :: (b -> t) -> Either a b -> Either a t
mapRight _ (Left a) = Left a
mapRight f (Right b) = Right $ f b
onSuccessM :: Monad m => m (Either a b) -> (b -> m c) -> m (Either a c)
onSuccessM ma msk = ma >>= step
where
step (Left a) = return (Left a)
step (Right b) = liftM Right $ msk b
pstar :: (a -> r -> ans)
-> (r -> a)
-> r -> ans
pstar f fa x = f (fa x) x
pstar2 :: (a -> b -> r -> ans)
-> (r -> a) -> (r -> b)
-> r -> ans
pstar2 f fa fb x = f (fa x) (fb x) x
star :: (r -> a)
-> (a -> r -> ans)
-> r -> ans
star fa f x = f (fa x) x
star2 :: (r -> a) -> (r -> b)
-> (a -> b -> r -> ans)
-> r -> ans
star2 fa fb f x = f (fa x) (fb x) x