{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}

-- | Optional values

module Feldspar.Data.Option
  ( OptionT
  , Option
  , none
  , some
  , guardO
  , guarded
  , rebuildOption
  , option
  , caseOption
  , fromSome
  , optionM
  , caseOptionM
  , fromSomeM
  , optionT
  , caseOptionT
  , fromSomeT
  ) where



import Prelude ()

import Control.Monad.Operational.Higher
import Control.Monad.Identity
import Control.Monad.Trans

import Language.Syntactic

import Feldspar
import Feldspar.Representation



data Opt fs a
  where
    None  :: String -> Opt (Param1 prog) a
    Guard :: String -> Data Bool -> Opt (Param1 prog) ()

instance HFunctor Opt
  where
    hfmap :: (forall (b :: k). f b -> g b) -> Opt '(f, fs) a -> Opt '(g, fs) a
hfmap forall (b :: k). f b -> g b
f (None String
msg)    = String -> Opt (Param1 g) a
forall k (prog :: k) a. String -> Opt (Param1 prog) a
None String
msg
    hfmap forall (b :: k). f b -> g b
f (Guard String
msg Data Bool
c) = String -> Data Bool -> Opt (Param1 g) ()
forall k (prog :: k). String -> Data Bool -> Opt (Param1 prog) ()
Guard String
msg Data Bool
c

-- | Transformer version of 'Option'
newtype OptionT m a = Option { OptionT m a -> ProgramT Opt () m a
unOption :: ProgramT Opt Param0 m a }
  deriving (a -> OptionT m b -> OptionT m a
(a -> b) -> OptionT m a -> OptionT m b
(forall a b. (a -> b) -> OptionT m a -> OptionT m b)
-> (forall a b. a -> OptionT m b -> OptionT m a)
-> Functor (OptionT m)
forall a b. a -> OptionT m b -> OptionT m a
forall a b. (a -> b) -> OptionT m a -> OptionT m b
forall (m :: * -> *) a b.
Monad m =>
a -> OptionT m b -> OptionT m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> OptionT m a -> OptionT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OptionT m b -> OptionT m a
$c<$ :: forall (m :: * -> *) a b.
Monad m =>
a -> OptionT m b -> OptionT m a
fmap :: (a -> b) -> OptionT m a -> OptionT m b
$cfmap :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> OptionT m a -> OptionT m b
Functor, Functor (OptionT m)
a -> OptionT m a
Functor (OptionT m)
-> (forall a. a -> OptionT m a)
-> (forall a b. OptionT m (a -> b) -> OptionT m a -> OptionT m b)
-> (forall a b c.
    (a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c)
-> (forall a b. OptionT m a -> OptionT m b -> OptionT m b)
-> (forall a b. OptionT m a -> OptionT m b -> OptionT m a)
-> Applicative (OptionT m)
OptionT m a -> OptionT m b -> OptionT m b
OptionT m a -> OptionT m b -> OptionT m a
OptionT m (a -> b) -> OptionT m a -> OptionT m b
(a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c
forall a. a -> OptionT m a
forall a b. OptionT m a -> OptionT m b -> OptionT m a
forall a b. OptionT m a -> OptionT m b -> OptionT m b
forall a b. OptionT m (a -> b) -> OptionT m a -> OptionT m b
forall a b c.
(a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c
forall (m :: * -> *). Monad m => Functor (OptionT m)
forall (m :: * -> *) a. Monad m => a -> OptionT m a
forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m a
forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m b
forall (m :: * -> *) a b.
Monad m =>
OptionT m (a -> b) -> OptionT m a -> OptionT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: OptionT m a -> OptionT m b -> OptionT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m a
*> :: OptionT m a -> OptionT m b -> OptionT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m b
liftA2 :: (a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> OptionT m a -> OptionT m b -> OptionT m c
<*> :: OptionT m (a -> b) -> OptionT m a -> OptionT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
OptionT m (a -> b) -> OptionT m a -> OptionT m b
pure :: a -> OptionT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> OptionT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (OptionT m)
Applicative, Applicative (OptionT m)
a -> OptionT m a
Applicative (OptionT m)
-> (forall a b. OptionT m a -> (a -> OptionT m b) -> OptionT m b)
-> (forall a b. OptionT m a -> OptionT m b -> OptionT m b)
-> (forall a. a -> OptionT m a)
-> Monad (OptionT m)
OptionT m a -> (a -> OptionT m b) -> OptionT m b
OptionT m a -> OptionT m b -> OptionT m b
forall a. a -> OptionT m a
forall a b. OptionT m a -> OptionT m b -> OptionT m b
forall a b. OptionT m a -> (a -> OptionT m b) -> OptionT m b
forall (m :: * -> *). Monad m => Applicative (OptionT m)
forall (m :: * -> *) a. Monad m => a -> OptionT m a
forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m b
forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> (a -> OptionT m b) -> OptionT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> OptionT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> OptionT m a
>> :: OptionT m a -> OptionT m b -> OptionT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> OptionT m b -> OptionT m b
>>= :: OptionT m a -> (a -> OptionT m b) -> OptionT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OptionT m a -> (a -> OptionT m b) -> OptionT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (OptionT m)
Monad, m a -> OptionT m a
(forall (m :: * -> *) a. Monad m => m a -> OptionT m a)
-> MonadTrans OptionT
forall (m :: * -> *) a. Monad m => m a -> OptionT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> OptionT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> OptionT m a
MonadTrans)

-- | Optional value, analogous to @`Either` `String` a@ in normal Haskell
type Option = OptionT Identity

instance MonadComp m => MonadComp (OptionT m)
  where
    liftComp :: Comp a -> OptionT m a
liftComp = m a -> OptionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> OptionT m a) -> (Comp a -> m a) -> Comp a -> OptionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comp a -> m a
forall (m :: * -> *) a. MonadComp m => Comp a -> m a
liftComp
    iff :: Data Bool -> OptionT m () -> OptionT m () -> OptionT m ()
iff Data Bool
c OptionT m ()
t OptionT m ()
f = do
        Ref (Data Bool)
okr <- Data Bool -> OptionT m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
true
        m () -> OptionT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> OptionT m ()) -> m () -> OptionT m ()
forall a b. (a -> b) -> a -> b
$ Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff Data Bool
c
            ((String -> m ()) -> (() -> m ()) -> OptionT m () -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
okr Data Bool
false) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return OptionT m ()
t)
            ((String -> m ()) -> (() -> m ()) -> OptionT m () -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
okr Data Bool
false) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return OptionT m ()
f)
        Data Bool
ok <- Ref (Data Bool) -> OptionT m (Data Bool)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Bool)
okr
        String -> Data Bool -> OptionT m ()
forall (m :: * -> *). String -> Data Bool -> OptionT m ()
guardO String
"iff: none" Data Bool
ok
    for :: IxRange (Data n) -> (Data n -> OptionT m ()) -> OptionT m ()
for IxRange (Data n)
rng Data n -> OptionT m ()
body = do
        Ref (Data Bool)
okr <- Data Bool -> OptionT m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
true
        m () -> OptionT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> OptionT m ()) -> m () -> OptionT m ()
forall a b. (a -> b) -> a -> b
$ IxRange (Data n) -> (Data n -> m ()) -> m ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for IxRange (Data n)
rng ((Data n -> m ()) -> m ()) -> (Data n -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Data n
i ->
            (String -> m ()) -> (() -> m ()) -> OptionT m () -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
okr Data Bool
false m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). MonadComp m => m ()
break) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (Data n -> OptionT m ()
body Data n
i)
        Data Bool
ok <- Ref (Data Bool) -> OptionT m (Data Bool)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Bool)
okr
        String -> Data Bool -> OptionT m ()
forall (m :: * -> *). String -> Data Bool -> OptionT m ()
guardO String
"for: none" Data Bool
ok
    while :: OptionT m (Data Bool) -> OptionT m () -> OptionT m ()
while OptionT m (Data Bool)
cont OptionT m ()
body = do
        Ref (Data Bool)
okr <- Data Bool -> OptionT m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
true
        m () -> OptionT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> OptionT m ()) -> m () -> OptionT m ()
forall a b. (a -> b) -> a -> b
$ m (Data Bool) -> m () -> m ()
forall (m :: * -> *). MonadComp m => m (Data Bool) -> m () -> m ()
while
            (Ref (Data Bool) -> m (Data Bool)
cont' Ref (Data Bool)
okr)
            ((String -> m ()) -> (() -> m ()) -> OptionT m () -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
okr Data Bool
false m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). MonadComp m => m ()
break) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return OptionT m ()
body)
        Data Bool
ok <- Ref (Data Bool) -> OptionT m (Data Bool)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Bool)
okr
        String -> Data Bool -> OptionT m ()
forall (m :: * -> *). String -> Data Bool -> OptionT m ()
guardO String
"while: none" Data Bool
ok
      where
        cont' :: Ref (Data Bool) -> m (Data Bool)
cont' Ref (Data Bool)
okr = do
            Ref (Data Bool)
cr <- m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => m (Ref a)
newRef
            OptionT m () -> (String -> m ()) -> (() -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
OptionT m a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionT (OptionT m (Data Bool)
cont OptionT m (Data Bool)
-> (Data Bool -> OptionT m ()) -> OptionT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref (Data Bool) -> Data Bool -> OptionT m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
cr) (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
okr Data Bool
false m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
cr Data Bool
false) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
            Ref (Data Bool) -> m (Data Bool)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Bool)
cr

instance Syntax a => Syntactic (Option a)
  where
    type Domain   (Option a) = FeldDomain
    type Internal (Option a) = (Bool, Internal a)

    desugar :: Option a -> ASTF (Domain (Option a)) (Internal (Option a))
desugar = Data (Bool, Internal a) -> ASTF FeldDomain (Bool, Internal a)
forall a. Data a -> ASTF FeldDomain a
unData (Data (Bool, Internal a) -> ASTF FeldDomain (Bool, Internal a))
-> (Option a -> Data (Bool, Internal a))
-> Option a
-> ASTF FeldDomain (Bool, Internal a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Data (Bool, Internal a))
-> (a -> Data (Bool, Internal a))
-> Option a
-> Data (Bool, Internal a)
forall b a. Syntax b => (String -> b) -> (a -> b) -> Option a -> b
option
        (\String
_ -> (Data Bool, Data (Internal a))
-> Data (Internal (Data Bool, Data (Internal a)))
forall a. Syntax a => a -> Data (Internal a)
Feldspar.desugar (Data Bool
false,Data (Internal a)
forall a. Syntax a => a
example :: (Data (Internal a))))
        (\a
a -> (Data Bool, a) -> Data (Internal (Data Bool, a))
forall a. Syntax a => a -> Data (Internal a)
Feldspar.desugar (Data Bool
true,a
a))

    sugar :: ASTF (Domain (Option a)) (Internal (Option a)) -> Option a
sugar ASTF (Domain (Option a)) (Internal (Option a))
o = String -> Data Bool -> a -> Option a
forall (m :: * -> *) a.
Monad m =>
String -> Data Bool -> a -> OptionT m a
guarded String
"sugar: none" Data Bool
valid a
a
      where
        (Data Bool
valid,a
a) = Data (Internal (Data Bool, a)) -> (Data Bool, a)
forall a. Syntax a => Data (Internal a) -> a
Feldspar.sugar (Data (Internal (Data Bool, a)) -> (Data Bool, a))
-> Data (Internal (Data Bool, a)) -> (Data Bool, a)
forall a b. (a -> b) -> a -> b
$ ASTF FeldDomain (Bool, Internal a) -> Data (Bool, Internal a)
forall a. ASTF FeldDomain a -> Data a
Data ASTF FeldDomain (Bool, Internal a)
ASTF (Domain (Option a)) (Internal (Option a))
o

-- | Construct a missing 'Option' value (analogous to 'Left' in normal Haskell)
none :: String -> OptionT m a
none :: String -> OptionT m a
none = ProgramT Opt () m a -> OptionT m a
forall (m :: * -> *) a. ProgramT Opt () m a -> OptionT m a
Option (ProgramT Opt () m a -> OptionT m a)
-> (String -> ProgramT Opt () m a) -> String -> OptionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opt '(ProgramT Opt () m, ()) a -> ProgramT Opt () m a
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) (m :: * -> *)
       a.
instr '(ProgramT instr fs m, fs) a -> ProgramT instr fs m a
singleton (Opt '(ProgramT Opt () m, ()) a -> ProgramT Opt () m a)
-> (String -> Opt '(ProgramT Opt () m, ()) a)
-> String
-> ProgramT Opt () m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Opt '(ProgramT Opt () m, ()) a
forall k (prog :: k) a. String -> Opt (Param1 prog) a
None

-- | Construct a present 'Option' value (analogous to 'Right' in normal Haskell)
some :: Monad m => a -> OptionT m a
some :: a -> OptionT m a
some = a -> OptionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Construct an 'Option' that is either 'none' or @`some` ()@ depending on
-- the Boolean guard
--
-- In the expression @`guardO` c `>>` rest@, the action @rest@ will not be
-- executed unless @c@ is true.
guardO :: String -> Data Bool -> OptionT m ()
guardO :: String -> Data Bool -> OptionT m ()
guardO String
msg Data Bool
c = ProgramT Opt () m () -> OptionT m ()
forall (m :: * -> *) a. ProgramT Opt () m a -> OptionT m a
Option (ProgramT Opt () m () -> OptionT m ())
-> ProgramT Opt () m () -> OptionT m ()
forall a b. (a -> b) -> a -> b
$ Opt '(ProgramT Opt () m, ()) () -> ProgramT Opt () m ()
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) (m :: * -> *)
       a.
instr '(ProgramT instr fs m, fs) a -> ProgramT instr fs m a
singleton (Opt '(ProgramT Opt () m, ()) () -> ProgramT Opt () m ())
-> Opt '(ProgramT Opt () m, ()) () -> ProgramT Opt () m ()
forall a b. (a -> b) -> a -> b
$ String -> Data Bool -> Opt '(ProgramT Opt () m, ()) ()
forall k (prog :: k). String -> Data Bool -> Opt (Param1 prog) ()
Guard String
msg Data Bool
c

-- | Construct an 'Option' from a guard and a value. The value will not be
-- evaluated if the guard is false.
guarded :: Monad m => String -> Data Bool -> a -> OptionT m a
guarded :: String -> Data Bool -> a -> OptionT m a
guarded String
msg Data Bool
c a
a = String -> Data Bool -> OptionT m ()
forall (m :: * -> *). String -> Data Bool -> OptionT m ()
guardO String
msg Data Bool
c OptionT m () -> OptionT m a -> OptionT m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> OptionT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

rebuildOption :: Monad m => Option a -> OptionT m a
rebuildOption :: Option a -> OptionT m a
rebuildOption = (forall b. Opt '(OptionT m, ()) b -> OptionT m b)
-> Program Opt () a -> OptionT m a
forall k (instr :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k)
       a.
(HFunctor instr, Monad m) =>
(forall b. instr '(m, fs) b -> m b) -> Program instr fs a -> m a
interpretWithMonad forall b. Opt '(OptionT m, ()) b -> OptionT m b
forall (m :: * -> *) a. Opt (Param1 (OptionT m)) a -> OptionT m a
go (Program Opt () a -> OptionT m a)
-> (Option a -> Program Opt () a) -> Option a -> OptionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> Program Opt () a
forall (m :: * -> *) a. OptionT m a -> ProgramT Opt () m a
unOption
  where
    go :: Opt (Param1 (OptionT m)) a -> OptionT m a
    go :: Opt (Param1 (OptionT m)) a -> OptionT m a
go (None String
msg)    = String -> OptionT m a
forall (m :: * -> *) a. String -> OptionT m a
none String
msg
    go (Guard String
msg Data Bool
c) = String -> Data Bool -> OptionT m ()
forall (m :: * -> *). String -> Data Bool -> OptionT m ()
guardO String
msg Data Bool
c

-- | Deconstruct an 'Option' value (analogous to 'either' in normal Haskell)
option :: Syntax b
    => (String -> b)  -- ^ 'none' case
    -> (a -> b)       -- ^ 'some' case
    -> Option a
    -> b
option :: (String -> b) -> (a -> b) -> Option a -> b
option String -> b
noneCase a -> b
someCase (Option ProgramT Opt () Identity a
opt) = ProgramViewT Opt () Identity a -> b
go (ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) a.
HFunctor instr =>
Program instr fs a -> ProgramView instr fs a
view ProgramT Opt () Identity a
opt)
  where
    go :: ProgramViewT Opt () Identity a -> b
go (Return a
a)           = a -> b
someCase a
a
    go (None msg    :>>= b -> ProgramT Opt () Identity a
k) = String -> b
noneCase String
msg
    go (Guard msg c :>>= b -> ProgramT Opt () Identity a
k) = Data Bool -> b -> b -> b
forall a. Syntax a => Data Bool -> a -> a -> a
cond Data Bool
c (ProgramViewT Opt () Identity a -> b
go (ProgramViewT Opt () Identity a -> b)
-> ProgramViewT Opt () Identity a -> b
forall a b. (a -> b) -> a -> b
$ ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) a.
HFunctor instr =>
Program instr fs a -> ProgramView instr fs a
view (ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a)
-> ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall a b. (a -> b) -> a -> b
$ b -> ProgramT Opt () Identity a
k ()) (String -> b
noneCase String
msg)

-- | Deconstruct an 'Option' value
caseOption :: Syntax b
    => Option a
    -> (String -> b)  -- ^ 'none' case
    -> (a -> b)       -- ^ 'some' case
    -> b
caseOption :: Option a -> (String -> b) -> (a -> b) -> b
caseOption Option a
o String -> b
n a -> b
s = (String -> b) -> (a -> b) -> Option a -> b
forall b a. Syntax b => (String -> b) -> (a -> b) -> Option a -> b
option String -> b
n a -> b
s Option a
o

-- | Extract the value of an 'Option' that is assumed to be present
fromSome :: Syntax a => Option a -> a
fromSome :: Option a -> a
fromSome = (String -> a) -> (a -> a) -> Option a -> a
forall b a. Syntax b => (String -> b) -> (a -> b) -> Option a -> b
option (a -> String -> a
forall a b. a -> b -> a
const a
forall a. Syntax a => a
example) a -> a
forall a. a -> a
id

-- | Deconstruct an 'Option' value (analogous to 'maybe' in normal Haskell)
optionM :: MonadComp m
    => (String -> m ())  -- ^ 'none' case
    -> (a -> m ())       -- ^ 'some' case
    -> Option a
    -> m ()
optionM :: (String -> m ()) -> (a -> m ()) -> Option a -> m ()
optionM String -> m ()
noneCase a -> m ()
someCase (Option ProgramT Opt () Identity a
opt) = ProgramViewT Opt () Identity a -> m ()
go (ProgramViewT Opt () Identity a -> m ())
-> ProgramViewT Opt () Identity a -> m ()
forall a b. (a -> b) -> a -> b
$ ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) a.
HFunctor instr =>
Program instr fs a -> ProgramView instr fs a
view ProgramT Opt () Identity a
opt
  where
    go :: ProgramViewT Opt () Identity a -> m ()
go (Return a
a)           = a -> m ()
someCase a
a
    go (None msg    :>>= b -> ProgramT Opt () Identity a
k) = String -> m ()
noneCase String
msg
    go (Guard msg c :>>= b -> ProgramT Opt () Identity a
k) = Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff Data Bool
c (ProgramViewT Opt () Identity a -> m ()
go (ProgramViewT Opt () Identity a -> m ())
-> ProgramViewT Opt () Identity a -> m ()
forall a b. (a -> b) -> a -> b
$ ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall k (instr :: (* -> *, k) -> * -> *) (fs :: k) a.
HFunctor instr =>
Program instr fs a -> ProgramView instr fs a
view (ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a)
-> ProgramT Opt () Identity a -> ProgramViewT Opt () Identity a
forall a b. (a -> b) -> a -> b
$ b -> ProgramT Opt () Identity a
k ()) (String -> m ()
noneCase String
msg)

-- | Deconstruct an 'Option' value
caseOptionM :: MonadComp m
    => Option a
    -> (String -> m ())  -- ^ 'none' case
    -> (a -> m ())       -- ^ 'some' case
    -> m ()
caseOptionM :: Option a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionM Option a
o String -> m ()
n a -> m ()
s = (String -> m ()) -> (a -> m ()) -> Option a -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> Option a -> m ()
optionM String -> m ()
n a -> m ()
s Option a
o

-- | Extract the value of an 'Option' that is assumed to be present
fromSomeM :: (Syntax a, MonadComp m) => Option a -> m a
fromSomeM :: Option a -> m a
fromSomeM Option a
opt = do
    Ref a
r <- m (Ref a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => m (Ref a)
newRef
    Option a -> (String -> m ()) -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
Option a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionM Option a
opt
        (m () -> String -> m ()
forall a b. a -> b -> a
const (m () -> String -> m ()) -> m () -> String -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (Ref a -> a -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref a
r)
    Ref a -> m a
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref a
r

-- | Deconstruct an 'OptionT' value
optionT :: MonadComp m
    => (String -> m ())  -- ^ 'none' case
    -> (a -> m ())       -- ^ 'some' case
    -> OptionT m a
    -> m ()
optionT :: (String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT String -> m ()
noneCase a -> m ()
someCase (Option ProgramT Opt () m a
opt) = ProgramViewT Opt () m a -> m ()
go (ProgramViewT Opt () m a -> m ())
-> m (ProgramViewT Opt () m a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProgramT Opt () m a -> m (ProgramViewT Opt () m a)
forall k (m :: * -> *) (instr :: (* -> *, k) -> * -> *) (fs :: k)
       a.
Monad m =>
ProgramT instr fs m a -> m (ProgramViewT instr fs m a)
viewT ProgramT Opt () m a
opt
  where
    go :: ProgramViewT Opt () m a -> m ()
go (Return a
a)           = a -> m ()
someCase a
a
    go (None msg    :>>= b -> ProgramT Opt () m a
k) = String -> m ()
noneCase String
msg
    go (Guard msg c :>>= b -> ProgramT Opt () m a
k) = Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff Data Bool
c (ProgramViewT Opt () m a -> m ()
go (ProgramViewT Opt () m a -> m ())
-> m (ProgramViewT Opt () m a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProgramT Opt () m a -> m (ProgramViewT Opt () m a)
forall k (m :: * -> *) (instr :: (* -> *, k) -> * -> *) (fs :: k)
       a.
Monad m =>
ProgramT instr fs m a -> m (ProgramViewT instr fs m a)
viewT (b -> ProgramT Opt () m a
k ())) (String -> m ()
noneCase String
msg)

-- | Deconstruct an 'OptionT' value
caseOptionT :: MonadComp m
    => OptionT m a
    -> (String -> m ())  -- ^ 'none' case
    -> (a -> m ())       -- ^ 'some' case
    -> m ()
caseOptionT :: OptionT m a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionT OptionT m a
o String -> m ()
n a -> m ()
s = (String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
forall (m :: * -> *) a.
MonadComp m =>
(String -> m ()) -> (a -> m ()) -> OptionT m a -> m ()
optionT String -> m ()
n a -> m ()
s OptionT m a
o

-- | Extract the value of an 'OptionT' that is assumed to be present
fromSomeT :: (Syntax a, MonadComp m) => OptionT m a -> m a
fromSomeT :: OptionT m a -> m a
fromSomeT OptionT m a
opt = do
    Ref a
r <- m (Ref a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => m (Ref a)
newRef
    OptionT m a -> (String -> m ()) -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
OptionT m a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionT OptionT m a
opt
        (m () -> String -> m ()
forall a b. a -> b -> a
const (m () -> String -> m ()) -> m () -> String -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (Ref a -> a -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref a
r)
    Ref a -> m a
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref a
r