{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE BangPatterns #-}

{- | Continuation-based control-flow

This module provides safe pattern matching on 'Data.Variant.V' values using
multi-continuations. Instead of pattern matching with the @V@ pattern (which
the compiler cannot check for completeness), we can provide a function per
constructor as in a pattern-match.

== Safe pattern matching with ordered continuations ('>:>')

With multi-continuations we can transform a variant @V [A,B,C]@ into a
function whose type is @(A -> r, B -> r, C -> r) -> r@. Hence the compiler
will ensure that we provide the correct number of alternatives in the
continuation tuple.

Applying a multi-continuation to a Variant is done with '>:>':

> import Data.Variant.ContFlow
>
> printV :: V [String,Int,Float] -> IO ()
> printV v = v >:>
>    ( \s -> putStrLn ("Found string: " ++ s)
>    , \i -> putStrLn ("Found int: " ++ show i)
>    , \f -> putStrLn ("Found float: " ++ show f)
>    )

== Safe pattern matching with unordered continuations ('>%:>')

By using the '>%:>' operator instead of '>:>', we can provide continuations in
any order as long as an alternative for each constructor is provided.

The types must be unambiguous as the Variant constructor types cannot be used to
infer the continuation types (as is done with '>:>'). Hence the type
ascriptions in the following example:

> printU :: V [String,Int,Float] -> IO ()
> printU v = v >%:>
>    ( \f -> putStrLn ("Found float: " ++ show (f :: Float))
>    , \s -> putStrLn ("Found string: " ++ s)
>    , \i -> putStrLn ("Found int: " ++ show (i :: Int))
>    )

-}
module Data.Variant.ContFlow
   ( ContFlow (..)
   , ContTuple
   , (>:>)
   , (>-:>)
   , (>%:>)
   , (>::>)
   , (>:-:>)
   , (>:%:>)
   , ToMultiCont
   , MultiCont (..)
   )
where

import Data.Kind
import Data.Variant.Tuple

-- | A continuation based control-flow
newtype ContFlow (xs :: [Type]) r = ContFlow (ContTuple xs r -> r)

-- | Convert a list of types into the actual data type representing the
-- continuations.
type family ContTuple (xs :: [Type]) r where
   ContTuple xs r = Tuple (ToMultiCont xs r)

type family ToMultiCont xs r where
   ToMultiCont '[] r       = '[]
   ToMultiCont (x ': xs) r = (x -> r) ': ToMultiCont xs r

-- | A multi-continuable type
class MultiCont a where
   type MultiContTypes a :: [Type]

   -- | Convert a data into a multi-continuation
   toCont :: a -> ContFlow (MultiContTypes a) r

   -- | Convert a data into a multi-continuation (monadic)
   toContM :: Monad m => m a -> ContFlow (MultiContTypes a) (m r)


-- | Bind a multi-continuable type to a tuple of continuations
(>:>) :: MultiCont a => a -> ContTuple (MultiContTypes a) r -> r
{-# INLINABLE (>:>) #-}
>:> :: forall a r. MultiCont a => a -> ContTuple (MultiContTypes a) r -> r
(>:>) a
a !ContTuple (MultiContTypes a) r
cs = a -> ContFlow (MultiContTypes a) r
forall r. a -> ContFlow (MultiContTypes a) r
forall a r. MultiCont a => a -> ContFlow (MultiContTypes a) r
toCont a
a ContFlow (MultiContTypes a) r
-> ContTuple (MultiContTypes a) r -> r
forall (xs :: [*]) r. ContFlow xs r -> ContTuple xs r -> r
>::> ContTuple (MultiContTypes a) r
cs

infixl 0 >:>

-- | Bind a single-continuable type to a 1-tuple of continuations
(>-:>) :: (MultiCont a, MultiContTypes a ~ '[b]) => a -> (b -> r) -> r
{-# INLINABLE (>-:>) #-}
>-:> :: forall a b r.
(MultiCont a, MultiContTypes a ~ '[b]) =>
a -> (b -> r) -> r
(>-:>) a
a b -> r
c = a -> ContFlow (MultiContTypes a) r
forall r. a -> ContFlow (MultiContTypes a) r
forall a r. MultiCont a => a -> ContFlow (MultiContTypes a) r
toCont a
a ContFlow '[b] r -> (b -> r) -> r
forall a r. ContFlow '[a] r -> (a -> r) -> r
>:-:> b -> r
c

infixl 0 >-:>

-- | Bind a multi-continuable type to a tuple of continuations and
-- reorder fields if necessary
(>%:>) ::
   ( MultiCont a
   , ReorderTuple ts (ContTuple (MultiContTypes a) r)
   ) => a -> ts -> r
{-# INLINABLE (>%:>) #-}
>%:> :: forall a ts r.
(MultiCont a, ReorderTuple ts (ContTuple (MultiContTypes a) r)) =>
a -> ts -> r
(>%:>) a
a !ts
cs = a -> ContFlow (MultiContTypes a) r
forall r. a -> ContFlow (MultiContTypes a) r
forall a r. MultiCont a => a -> ContFlow (MultiContTypes a) r
toCont a
a ContFlow (MultiContTypes a) r -> ts -> r
forall ts (xs :: [*]) r.
ReorderTuple ts (ContTuple xs r) =>
ContFlow xs r -> ts -> r
>:%:> ts
cs

infixl 0 >%:>


-- | Bind a flow to a tuple of continuations
(>::>) :: ContFlow xs r -> ContTuple xs r -> r
{-# INLINABLE (>::>) #-}
>::> :: forall (xs :: [*]) r. ContFlow xs r -> ContTuple xs r -> r
(>::>) (ContFlow ContTuple xs r -> r
f) !ContTuple xs r
cs = ContTuple xs r -> r
f ContTuple xs r
cs

infixl 0 >::>

-- | Bind a flow to a 1-tuple of continuations
(>:-:>) :: ContFlow '[a] r -> (a -> r) -> r
{-# INLINABLE (>:-:>) #-}
>:-:> :: forall a r. ContFlow '[a] r -> (a -> r) -> r
(>:-:>) (ContFlow ContTuple '[a] r -> r
f) a -> r
c = ContTuple '[a] r -> r
f ((a -> r) -> Solo (a -> r)
forall a. a -> Solo a
MkSolo a -> r
c)

infixl 0 >:-:>

-- | Bind a flow to a tuple of continuations and
-- reorder fields if necessary
(>:%:>) :: forall ts xs r.
   ( ReorderTuple ts (ContTuple xs r)
   ) => ContFlow xs r -> ts -> r
{-# INLINABLE (>:%:>) #-}
>:%:> :: forall ts (xs :: [*]) r.
ReorderTuple ts (ContTuple xs r) =>
ContFlow xs r -> ts -> r
(>:%:>) (ContFlow ContTuple xs r -> r
f) !ts
cs = ContTuple xs r -> r
f (ts -> Tuple (ToMultiCont xs r)
forall t1 t2. ReorderTuple t1 t2 => t1 -> t2
tupleReorder ts
cs)

infixl 0 >:%:>