{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
module Turtle.Shell (
Shell(..)
, FoldShell(..)
, _foldIO
, _Shell
, foldIO
, foldShell
, fold
, reduce
, sh
, view
, select
, liftIO
, using
) where
import Control.Applicative
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Managed (MonadManaged(..), with)
import qualified Control.Monad.Fail as Fail
import Control.Foldl (Fold(..), FoldM(..))
import qualified Control.Foldl as Foldl
import Data.Foldable (Foldable)
import qualified Data.Foldable
import Data.Monoid
import Data.String (IsString(..))
import Prelude
data FoldShell a b = forall x . FoldShell (x -> a -> IO x) x (x -> IO b)
newtype Shell a = Shell { Shell a -> forall r. FoldShell a r -> IO r
_foldShell:: forall r . FoldShell a r -> IO r }
data Maybe' a = Just' !a | Nothing'
translate :: FoldM IO a b -> FoldShell a b
translate :: FoldM IO a b -> FoldShell a b
translate (FoldM step :: x -> a -> IO x
step begin :: IO x
begin done :: x -> IO b
done) = (Maybe' x -> a -> IO (Maybe' x))
-> Maybe' x -> (Maybe' x -> IO b) -> FoldShell a b
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell Maybe' x -> a -> IO (Maybe' x)
step' Maybe' x
forall a. Maybe' a
Nothing' Maybe' x -> IO b
done'
where
step' :: Maybe' x -> a -> IO (Maybe' x)
step' Nothing' a :: a
a = do
x
x <- IO x
begin
x
x' <- x -> a -> IO x
step x
x a
a
Maybe' x -> IO (Maybe' x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' x -> IO (Maybe' x)) -> Maybe' x -> IO (Maybe' x)
forall a b. (a -> b) -> a -> b
$! x -> Maybe' x
forall a. a -> Maybe' a
Just' x
x'
step' (Just' x :: x
x) a :: a
a = do
x
x' <- x -> a -> IO x
step x
x a
a
Maybe' x -> IO (Maybe' x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' x -> IO (Maybe' x)) -> Maybe' x -> IO (Maybe' x)
forall a b. (a -> b) -> a -> b
$! x -> Maybe' x
forall a. a -> Maybe' a
Just' x
x'
done' :: Maybe' x -> IO b
done' Nothing' = do
x
x <- IO x
begin
x -> IO b
done x
x
done' (Just' x :: x
x) = do
x -> IO b
done x
x
foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r
foldIO :: Shell a -> FoldM IO a r -> io r
foldIO s :: Shell a
s f :: FoldM IO a r
f = IO r -> io r
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Shell a -> FoldM IO a r -> IO r
forall a r. Shell a -> FoldM IO a r -> IO r
_foldIO Shell a
s FoldM IO a r
f)
_foldIO :: Shell a -> FoldM IO a r -> IO r
_foldIO :: Shell a -> FoldM IO a r -> IO r
_foldIO s :: Shell a
s foldM :: FoldM IO a r
foldM = Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (FoldM IO a r -> FoldShell a r
forall a b. FoldM IO a b -> FoldShell a b
translate FoldM IO a r
foldM)
_Shell :: (forall r . FoldM IO a r -> IO r) -> Shell a
_Shell :: (forall r. FoldM IO a r -> IO r) -> Shell a
_Shell f :: forall r. FoldM IO a r -> IO r
f = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (FoldM IO a r -> IO r
forall r. FoldM IO a r -> IO r
f (FoldM IO a r -> IO r)
-> (FoldShell a r -> FoldM IO a r) -> FoldShell a r -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldShell a r -> FoldM IO a r
forall a b. FoldShell a b -> FoldM IO a b
adapt)
where
adapt :: FoldShell a b -> FoldM IO a b
adapt (FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO b
done) = (x -> a -> IO x) -> IO x -> (x -> IO b) -> FoldM IO a b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> IO x
step (x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
begin) x -> IO b
done
foldShell :: MonadIO io => Shell a -> FoldShell a b -> io b
foldShell :: Shell a -> FoldShell a b -> io b
foldShell s :: Shell a
s f :: FoldShell a b
f = IO b -> io b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Shell a -> FoldShell a b -> IO b
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s FoldShell a b
f)
fold :: MonadIO io => Shell a -> Fold a b -> io b
fold :: Shell a -> Fold a b -> io b
fold s :: Shell a
s f :: Fold a b
f = Shell a -> FoldM IO a b -> io b
forall (io :: * -> *) a r.
MonadIO io =>
Shell a -> FoldM IO a r -> io r
foldIO Shell a
s (Fold a b -> FoldM IO a b
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
Foldl.generalize Fold a b
f)
reduce :: MonadIO io => Fold a b -> Shell a -> io b
reduce :: Fold a b -> Shell a -> io b
reduce = (Shell a -> Fold a b -> io b) -> Fold a b -> Shell a -> io b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Shell a -> Fold a b -> io b
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold
sh :: MonadIO io => Shell a -> io ()
sh :: Shell a -> io ()
sh s :: Shell a
s = Shell a -> Fold a () -> io ()
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell a
s (() -> Fold a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
view :: (MonadIO io, Show a) => Shell a -> io ()
view :: Shell a -> io ()
view s :: Shell a
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
a
x <- Shell a
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO ()
forall a. Show a => a -> IO ()
print a
x) )
instance Functor Shell where
fmap :: (a -> b) -> Shell a -> Shell b
fmap f :: a -> b
f s :: Shell a
s = (forall r. FoldShell b r -> IO r) -> Shell b
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> b -> IO x
step begin :: x
begin done :: x -> IO r
done) ->
let step' :: x -> a -> IO x
step' x :: x
x a :: a
a = x -> b -> IO x
step x
x (a -> b
f a
a)
in Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s ((x -> a -> IO x) -> x -> (x -> IO r) -> FoldShell a r
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step' x
begin x -> IO r
done) )
instance Applicative Shell where
pure :: a -> Shell a
pure = a -> Shell a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Shell (a -> b) -> Shell a -> Shell b
(<*>) = Shell (a -> b) -> Shell a -> Shell b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Shell where
return :: a -> Shell a
return a :: a
a = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
x
x <- x -> a -> IO x
step x
begin a
a
x -> IO r
done x
x )
m :: Shell a
m >>= :: Shell a -> (a -> Shell b) -> Shell b
>>= f :: a -> Shell b
f = (forall r. FoldShell b r -> IO r) -> Shell b
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step0 :: x -> b -> IO x
step0 begin0 :: x
begin0 done0 :: x -> IO r
done0) -> do
let step1 :: x -> a -> IO x
step1 x :: x
x a :: a
a = Shell b -> FoldShell b x -> IO x
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell (a -> Shell b
f a
a) ((x -> b -> IO x) -> x -> (x -> IO x) -> FoldShell b x
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> b -> IO x
step0 x
x x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return)
Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
m ((x -> a -> IO x) -> x -> (x -> IO r) -> FoldShell a r
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step1 x
begin0 x -> IO r
done0) )
#if!(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Alternative Shell where
empty :: Shell a
empty = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell _ begin :: x
begin done :: x -> IO r
done) -> x -> IO r
done x
begin)
s1 :: Shell a
s1 <|> :: Shell a -> Shell a -> Shell a
<|> s2 :: Shell a
s2 = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
x
x <- Shell a -> FoldShell a x -> IO x
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s1 ((x -> a -> IO x) -> x -> (x -> IO x) -> FoldShell a x
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step x
begin x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return)
Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s2 ((x -> a -> IO x) -> x -> (x -> IO r) -> FoldShell a r
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step x
x x -> IO r
done) )
instance MonadPlus Shell where
mzero :: Shell a
mzero = Shell a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Shell a -> Shell a -> Shell a
mplus = Shell a -> Shell a -> Shell a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance MonadIO Shell where
liftIO :: IO a -> Shell a
liftIO io :: IO a
io = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
a
a <- IO a
io
x
x <- x -> a -> IO x
step x
begin a
a
x -> IO r
done x
x )
instance MonadManaged Shell where
using :: Managed a -> Shell a
using resource :: Managed a
resource = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
x
x <- Managed a -> (a -> IO x) -> IO x
forall a r. Managed a -> (a -> IO r) -> IO r
with Managed a
resource (x -> a -> IO x
step x
begin)
x -> IO r
done x
x )
instance MonadThrow Shell where
throwM :: e -> Shell a
throwM e :: e
e = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\_ -> e -> IO r
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e)
instance MonadCatch Shell where
m :: Shell a
m catch :: Shell a -> (e -> Shell a) -> Shell a
`catch` k :: e -> Shell a
k = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\f :: FoldShell a r
f-> Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
m FoldShell a r
f IO r -> (e -> IO r) -> IO r
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\e :: e
e -> Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell (e -> Shell a
k e
e) FoldShell a r
f))
instance Fail.MonadFail Shell where
fail :: String -> Shell a
fail _ = Shell a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
#if __GLASGOW_HASKELL__ >= 804
instance Monoid a => Semigroup (Shell a) where
<> :: Shell a -> Shell a -> Shell a
(<>) = Shell a -> Shell a -> Shell a
forall a. Monoid a => a -> a -> a
mappend
#endif
instance Monoid a => Monoid (Shell a) where
mempty :: Shell a
mempty = a -> Shell a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
mappend :: Shell a -> Shell a -> Shell a
mappend = (a -> a -> a) -> Shell a -> Shell a -> Shell a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
instance Monoid a => Num (Shell a) where
fromInteger :: Integer -> Shell a
fromInteger n :: Integer
n = [a] -> Shell a
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) a
forall a. Monoid a => a
mempty)
+ :: Shell a -> Shell a -> Shell a
(+) = Shell a -> Shell a -> Shell a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
* :: Shell a -> Shell a -> Shell a
(*) = Shell a -> Shell a -> Shell a
forall a. Semigroup a => a -> a -> a
(<>)
instance IsString a => IsString (Shell a) where
fromString :: String -> Shell a
fromString str :: String
str = a -> Shell a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> a
forall a. IsString a => String -> a
fromString String
str)
select :: Foldable f => f a -> Shell a
select :: f a -> Shell a
select as :: f a
as = (forall r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> a -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
let step' :: a -> (x -> IO b) -> x -> IO b
step' a :: a
a k :: x -> IO b
k x :: x
x = do
x
x' <- x -> a -> IO x
step x
x a
a
x -> IO b
k (x -> IO b) -> x -> IO b
forall a b. (a -> b) -> a -> b
$! x
x'
(a -> (x -> IO r) -> x -> IO r) -> (x -> IO r) -> f a -> x -> IO r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.Foldable.foldr a -> (x -> IO r) -> x -> IO r
forall b. a -> (x -> IO b) -> x -> IO b
step' x -> IO r
done f a
as (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )