content: {-# LANGUAGE RankNTypes #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module     : Control.Selective.Free
  -- Copyright  : (c) Andrey Mokhov 2018-2024
  -- License    : MIT (see the file LICENSE)
  -- Maintainer : andrey.mokhov@gmail.com
  -- Stability  : experimental
  --
  -- This is a library for /selective applicative functors/, or just
  -- /selective functors/ for short, an abstraction between applicative functors
  -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694.
  --
  -- This module defines /free selective functors/ using the ideas from the
  -- Sjoerd Visscher's package 'free-functors':
  -- https://hackage.haskell.org/package/free-functors-1.0.1/docs/Data-Functor-HFree.html.
  --
  -----------------------------------------------------------------------------
  module Control.Selective.Free (
      -- * Free selective functors
      Select (..), liftSelect,
  
      -- * Static analysis
      getPure, getEffects, getNecessaryEffects, runSelect, foldSelect
      ) where
  
  import Control.Selective
  import Data.Functor
  
  -- | Free selective functors.
  newtype Select f a = Select (forall g. Selective g => (forall x. f x -> g x) -> g a)
  
  -- Ignoring the hint, since GHC can't type check the suggested code.
  {-# ANN module "HLint: ignore Use fmap" #-}
  instance Functor (Select f) where
      fmap f (Select x) = Select $ \k -> f <$> x k
  
  instance Applicative (Select f) where
      pure a                = Select $ \_ -> pure a
      Select x <*> Select y = Select $ \k -> x k <*> y k
  
  instance Selective (Select f) where
      select (Select x) (Select y) = Select $ \k -> x k <*? y k
  
  -- | Lift a functor into a free selective computation.
  liftSelect :: f a -> Select f a
  liftSelect x = Select (\f -> f x)
  
  -- | Given a natural transformation from @f@ to @g@, this gives a canonical
  -- natural transformation from @Select f@ to @g@. Note that here we rely on the
  -- fact that @g@ is a lawful selective functor.
  runSelect :: Selective g => (forall x. f x -> g x) -> Select f a -> g a
  runSelect k (Select x) = x k
  
  -- | Concatenate all effects of a free selective computation.
  foldSelect :: Monoid m => (forall x. f x -> m) -> Select f a -> m
  foldSelect f = getOver . runSelect (Over . f)
  
  -- | Extract the resulting value if there are no necessary effects.
  getPure :: Select f a -> Maybe a
  getPure = runSelect (const Nothing)
  
  -- | Collect /all possible effects/ in the order they appear in a free selective
  -- computation.
  getEffects :: Functor f => Select f a -> [f ()]
  getEffects = foldSelect (pure . void)
  
  -- | Extract /all necessary effects/ in the order they appear in a free
  -- selective computation.
  getNecessaryEffects :: Functor f => Select f a -> [f ()]
  getNecessaryEffects = getUnder . runSelect (Under . pure . void)
  