{- |
   Module     : Polysemy.Methodology.Composite
   License    : MIT
   Maintainer : dan.firth@homotopic.tech
   Stability  : experimental

Functions for combining polysemy-methodology with composite.
-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
module Polysemy.Methodology.Composite (
  runCoRecMethodologyAsCases
, runCoRecMethodologyAsCases'
, diffractMethodology
, diffractMethodology'
, runInputCase'
) where

import Control.Arrow
import Composite.CoRecord
import Data.Vinyl
import Polysemy
import Polysemy.Extra
import Polysemy.Input
import Polysemy.Methodology

-- | Run a `Methodology` from a `CoRec` to an `Input` of `Cases'`. You can then use `Polysemy.Vinyl.separateRecInput` and `Polysemy.Vinyl.stripRecInput`
-- to deal with the cases individually.
--
-- @since 0.1.0.0
runCoRecMethodologyAsCases :: forall f zs c x xs r a.
                              (zs ~ (x ': xs), RecApplicative zs, Members '[Input (Cases' f zs c)] r)
                           => Sem (Methodology (CoRec f zs) c ': r) a
                              -- ^ The Methodology to decompose.
                           -> Sem r a
runCoRecMethodologyAsCases = interpret \case
  Process b -> do
    x <- input @(Cases' f zs c)
    return $ foldCoRec x b
{-# INLINE runCoRecMethodologyAsCases #-}

-- | Reinterpreting version of `runCoRecMethodologyAsCases`.
--
--
-- @since 0.1.0.0
runCoRecMethodologyAsCases' :: forall f zs c x xs r a.
                               (zs ~ (x ': xs), RecApplicative zs)
                            => Sem (Methodology (CoRec f zs) c ': r) a
                               -- ^ The Methodology to decompose.
                            -> Sem (Input (Cases' f zs c) ': r) a
runCoRecMethodologyAsCases' = reinterpret \case
  Process b -> do
    x <- input @(Cases' f zs c)
    return $ foldCoRec x b
{-# INLINE runCoRecMethodologyAsCases' #-}

-- | Diffraction is a combination of a `cutMethodology'`, an `mconcatMethodology'` and a `runCoRecMethodologyAsCases`.
--
-- This effectively allows you to make several ad-hoc constructors for d and fully consumes the second half of the cut.
-- This turns out to be quite a good way to start a simple pipeline.
--
-- @since 0.1.0.0
diffractMethodology :: forall b f zs d x xs r a.
                       (Monoid d, zs ~ (x ': xs)
                      , RecApplicative zs
                      , Members '[ Methodology b [CoRec f zs]
                                 , Input (Cases' f zs d)] r)
                    => Sem (Methodology b d ': r) a
                       -- ^ The Methodology to decompose.
                    -> Sem r a
diffractMethodology = cutMethodology' @b @[CoRec f zs] @d
                  >>> reinterpretUnder mconcatMethodology'
                  >>> reinterpretUnder runCoRecMethodologyAsCases'
                  >>> subsume >>> subsume
{-# INLINE diffractMethodology #-}

-- | Reinterpreting version of `diffractMethodology`.
--
-- @since 0.1.0.0
diffractMethodology' :: forall b f zs d x xs r a.
                        (Monoid d, zs ~ (x ': xs), RecApplicative zs)
                     => Sem (Methodology b d ': r) a
                        -- ^ The Methodology to decompose.
                     -> Sem (Methodology b [CoRec f zs] ': Input (Cases' f zs d) ': r) a
diffractMethodology' = cutMethodology' @b @[CoRec f zs] @d
                   >>> reinterpretUnder mconcatMethodology'
                   >>> reinterpretUnder runCoRecMethodologyAsCases'
{-# INLINE diffractMethodology' #-}

-- | Run a `Case'` using `runInputConst` and a function eliminating the `Case'`.
--
-- @since 0.1.1.0
runInputCase' :: forall b f t r a.
                 (f b -> t)
              -> Sem (Input (Case' f t b) ': r) a
              -> Sem r a
runInputCase' f = runInputConst (Case' f)
{-# INLINE runInputCase' #-}