{-|
Module     : Jaskell
Copyright  : (c) Owen Bechtel, 2023
License    : MIT
Maintainer : ombspring@gmail.com
Stability  : experimental
-}

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TupleSections #-}
module Jaskell 
  ( -- * Running programs
    run, runOn, runK, runKOn
    -- * Stack utilities
  , push, liftS, liftS2, pushM, popM, liftSM
  ) where

import Control.Arrow (Arrow, arr, Kleisli(Kleisli))

-- | Run a direct Jaskell program on an empty stack.
run :: (() -> t) -> t
run :: forall t. (() -> t) -> t
run () -> t
f = () -> t
f ()

-- | Run a direct Jaskell program on the given stack.
runOn :: s -> (s -> t) -> t
runOn :: forall s t. s -> (s -> t) -> t
runOn s
s s -> t
f = s -> t
f s
s

-- | Run a monadic Jaskell program on an empty stack.
runK :: Kleisli m () t -> m t
runK :: forall (m :: * -> *) t. Kleisli m () t -> m t
runK (Kleisli () -> m t
f) = () -> m t
f ()

-- | Run a monadic Jaskell program on the given stack.
runKOn :: s -> Kleisli m s t -> m t
runKOn :: forall s (m :: * -> *) t. s -> Kleisli m s t -> m t
runKOn s
s (Kleisli s -> m t
f) = s -> m t
f s
s

-- | Push a value.
push :: Arrow arr => a -> arr s (s, a)
push :: forall (arr :: * -> * -> *) a s. Arrow arr => a -> arr s (s, a)
push a
x = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (, a
x)

-- | Apply a function to the top value.
liftS :: Arrow arr => (a -> b) -> arr (s, a) (s, b)
liftS :: forall (arr :: * -> * -> *) a b s.
Arrow arr =>
(a -> b) -> arr (s, a) (s, b)
liftS a -> b
f = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

-- | Apply a function to the top two values.
liftS2 :: Arrow arr => (a -> b -> c) -> arr ((s, a), b) (s, c)
liftS2 :: forall (arr :: * -> * -> *) a b c s.
Arrow arr =>
(a -> b -> c) -> arr ((s, a), b) (s, c)
liftS2 a -> b -> c
f = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), b
y) -> (s
s, a -> b -> c
f a
x b
y)

-- | Perform a monadic action and push the result.
pushM :: Functor m => m a -> Kleisli m s (s, a)
pushM :: forall (m :: * -> *) a s. Functor m => m a -> Kleisli m s (s, a)
pushM m a
mx = forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli \s
s -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
s, ) m a
mx

-- | Pop the top value and feed it to a monadic action.
popM :: Functor m => (a -> m ()) -> Kleisli m (s, a) s
popM :: forall (m :: * -> *) a s.
Functor m =>
(a -> m ()) -> Kleisli m (s, a) s
popM a -> m ()
f = forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli \(s
s, a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const s
s) (a -> m ()
f a
x)

-- | Pop the top value, feed it to a monadic action, and push the result.
liftSM :: Functor m => (a -> m b) -> Kleisli m (s, a) (s, b)
liftSM :: forall (m :: * -> *) a b s.
Functor m =>
(a -> m b) -> Kleisli m (s, a) (s, b)
liftSM a -> m b
f = forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli \(s
s, a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
s, ) (a -> m b
f a
x)