module Turtle.Shell (
Shell(..)
, foldIO
, fold
, sh
, view
, select
, liftIO
, using
) where
import Control.Applicative (Applicative(..), Alternative(..), liftA2)
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Managed (Managed, with)
import Control.Foldl (Fold(..), FoldM(..))
import qualified Control.Foldl as Foldl
import Data.Monoid (Monoid(..), (<>))
import Data.String (IsString(..))
newtype Shell a = Shell { _foldIO :: forall r . FoldM IO a r -> IO r }
foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r
foldIO s f = liftIO (_foldIO s f)
fold :: MonadIO io => Shell a -> Fold a b -> io b
fold s f = foldIO s (Foldl.generalize f)
sh :: MonadIO io => Shell a -> io ()
sh s = fold s (pure ())
view :: (MonadIO io, Show a) => Shell a -> io ()
view s = sh (do
x <- s
liftIO (print x) )
instance Functor Shell where
fmap f s = Shell (\(FoldM step begin done) ->
let step' x a = step x (f a)
in _foldIO s (FoldM step' begin done) )
instance Applicative Shell where
pure = return
(<*>) = ap
instance Monad Shell where
return a = Shell (\(FoldM step begin done) -> do
x <- begin
x' <- step x a
done x' )
m >>= f = Shell (\(FoldM step0 begin0 done0) -> do
let step1 x a = _foldIO (f a) (FoldM step0 (return x) return)
_foldIO m (FoldM step1 begin0 done0) )
fail _ = mzero
instance Alternative Shell where
empty = Shell (\(FoldM _ begin done) -> do
x <- begin
done x )
s1 <|> s2 = Shell (\(FoldM step begin done) -> do
x <- _foldIO s1 (FoldM step begin return)
_foldIO s2 (FoldM step (return x) done) )
instance MonadPlus Shell where
mzero = empty
mplus = (<|>)
instance MonadIO Shell where
liftIO io = Shell (\(FoldM step begin done) -> do
x <- begin
a <- io
x' <- step x a
done x' )
instance Monoid a => Monoid (Shell a) where
mempty = pure mempty
mappend = liftA2 mappend
instance Monoid a => Num (Shell a) where
fromInteger n = select (replicate (fromInteger n) mempty)
(+) = (<|>)
(*) = (<>)
instance IsString a => IsString (Shell a) where
fromString str = pure (fromString str)
select :: [a] -> Shell a
select as = Shell (\(FoldM step begin done) -> do
x0 <- begin
let step' a k x = do
x' <- step x a
k $! x'
foldr step' done as $! x0 )
using :: Managed a -> Shell a
using resource = Shell (\(FoldM step begin done) -> do
x <- begin
x' <- with resource (step x)
done x' )