    {-# LANGUAGE RankNTypes #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module     : Control.Selective.Free
    -- Copyright  : (c) Andrey Mokhov 2018-2023
    -- 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://www.staff.ncl.ac.uk/andrey.mokhov/selective-functors.pdf.
    --
    -- 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 :: forall a b. (a -> b) -> Select f a -> Select f b
    fmap a -> b
    f (Select forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    x) = (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g b)
    -> Select f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    Select ((forall (g :: * -> *).
      Selective g =>
      (forall x. f x -> g x) -> g b)
     -> Select f b)
    -> (forall (g :: * -> *).
        Selective g =>
        (forall x. f x -> g x) -> g b)
    -> Select f b
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    k -> a -> b
    f (a -> b) -> g a -> g b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall x. f x -> g x) -> g a
    forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k

    instance Applicative (Select f) where
        pure :: forall a. a -> Select f a
    pure a
    a                = (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    Select ((forall (g :: * -> *).
      Selective g =>
      (forall x. f x -> g x) -> g a)
     -> Select f a)
    -> (forall (g :: * -> *).
        Selective g =>
        (forall x. f x -> g x) -> g a)
    -> Select f a
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    _ -> a -> g a
    forall a. a -> g a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a
        Select forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (a -> b)
    x <*> :: forall a b. Select f (a -> b) -> Select f a -> Select f b
    <*> Select forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    y = (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g b)
    -> Select f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    Select ((forall (g :: * -> *).
      Selective g =>
      (forall x. f x -> g x) -> g b)
     -> Select f b)
    -> (forall (g :: * -> *).
        Selective g =>
        (forall x. f x -> g x) -> g b)
    -> Select f b
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g (a -> b)
    forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (a -> b)
    x f x -> g x
    forall x. f x -> g x
    k g (a -> b) -> g a -> g b
    forall a b. g (a -> b) -> g a -> g b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (forall x. f x -> g x) -> g a
    forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    y f x -> g x
    forall x. f x -> g x
    k

    instance Selective (Select f) where
        select :: forall a b.
    Select f (Either a b) -> Select f (a -> b) -> Select f b
    select (Select forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (Either a b)
    x) (Select forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (a -> b)
    y) = (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g b)
    -> Select f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    Select ((forall (g :: * -> *).
      Selective g =>
      (forall x. f x -> g x) -> g b)
     -> Select f b)
    -> (forall (g :: * -> *).
        Selective g =>
        (forall x. f x -> g x) -> g b)
    -> Select f b
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g (Either a b)
    forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (Either a b)
    x f x -> g x
    forall x. f x -> g x
    k g (Either a b) -> g (a -> b) -> g b
    forall (f :: * -> *) a b.
    Selective f =>
    f (Either a b) -> f (a -> b) -> f b
    <*? (forall x. f x -> g x) -> g (a -> b)
    forall (g :: * -> *).
    Selective g =>
    (forall x. f x -> g x) -> g (a -> b)
    y f x -> g x
    forall x. f x -> g x
    k

    -- | Lift a functor into a free selective computation.
    liftSelect :: f a -> Select f a
    liftSelect :: forall (f :: * -> *) a. f a -> Select f a
    liftSelect f a
    x = (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Selective g =>
     (forall x. f x -> g x) -> g a)
    -> Select f a
    Select (\forall x. f x -> g x
    f -> f a -> g a
    forall x. f x -> g x
    f f a
    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 :: forall (g :: * -> *) (f :: * -> *) a.
    Selective g =>
    (forall x. f x -> g x) -> Select f a -> g a
    runSelect forall x. f x -> g x
    k (Select forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    x) = (forall x. f x -> g x) -> g a
    forall (g :: * -> *). Selective g => (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k

    -- | Concatenate all effects of a free selective computation.
    foldSelect :: Monoid m => (forall x. f x -> m) -> Select f a -> m
    foldSelect :: forall m (f :: * -> *) a.
    Monoid m =>
    (forall x. f x -> m) -> Select f a -> m
    foldSelect forall x. f x -> m
    f = Over m a -> m
    forall m a. Over m a -> m
    getOver (Over m a -> m) -> (Select f a -> Over m a) -> Select f a -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall x. f x -> Over m x) -> Select f a -> Over m a
    forall (g :: * -> *) (f :: * -> *) a.
    Selective g =>
    (forall x. f x -> g x) -> Select f a -> g a
    runSelect (m -> Over m x
    forall m a. m -> Over m a
    Over (m -> Over m x) -> (f x -> m) -> f x -> Over m x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> m
    forall x. f x -> m
    f)

    -- | Extract the resulting value if there are no necessary effects.
    getPure :: Select f a -> Maybe a
    getPure :: forall (f :: * -> *) a. Select f a -> Maybe a
    getPure = (forall x. f x -> Maybe x) -> Select f a -> Maybe a
    forall (g :: * -> *) (f :: * -> *) a.
    Selective g =>
    (forall x. f x -> g x) -> Select f a -> g a
    runSelect (Maybe x -> f x -> Maybe x
    forall a b. a -> b -> a
    const Maybe x
    forall a. Maybe a
    Nothing)

    -- | Collect /all possible effects/ in the order they appear in a free selective
    -- computation.
    getEffects :: Functor f => Select f a -> [f ()]
    getEffects :: forall (f :: * -> *) a. Functor f => Select f a -> [f ()]
    getEffects = (forall x. f x -> [f ()]) -> Select f a -> [f ()]
    forall m (f :: * -> *) a.
    Monoid m =>
    (forall x. f x -> m) -> Select f a -> m
    foldSelect (f () -> [f ()]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (f () -> [f ()]) -> (f x -> f ()) -> f x -> [f ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> f ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void)

    -- | Extract /all necessary effects/ in the order they appear in a free
    -- selective computation.
    getNecessaryEffects :: Functor f => Select f a -> [f ()]
    getNecessaryEffects :: forall (f :: * -> *) a. Functor f => Select f a -> [f ()]
    getNecessaryEffects = Under [f ()] a -> [f ()]
    forall m a. Under m a -> m
    getUnder (Under [f ()] a -> [f ()])
    -> (Select f a -> Under [f ()] a) -> Select f a -> [f ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall x. f x -> Under [f ()] x) -> Select f a -> Under [f ()] a
    forall (g :: * -> *) (f :: * -> *) a.
    Selective g =>
    (forall x. f x -> g x) -> Select f a -> g a
    runSelect ([f ()] -> Under [f ()] x
    forall m a. m -> Under m a
    Under ([f ()] -> Under [f ()] x)
    -> (f x -> [f ()]) -> f x -> Under [f ()] x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f () -> [f ()]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (f () -> [f ()]) -> (f x -> f ()) -> f x -> [f ()]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> f ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void)