{-# LANGUAGE
  AllowAmbiguousTypes,
  BlockArguments,
  CPP,
  DuplicateRecordFields,
  ImpredicativeTypes,
  KindSignatures,
  NamedFieldPuns,
  PolyKinds,
  RankNTypes,
  ScopedTypeVariables,
  TemplateHaskell,
  TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Dictionaries for /base/ classes.

module FCI.Base (
    -- * Dictionary types
    DictEq(..)
  , DictOrd(..)
  , DictSemigroup(..)
  , DictMonoid(..)
  , DictShow(..)
  , DictRead(..)
  , DictEnum(..)
  , DictBounded(..)
  , DictNum(..)
  , DictReal(..)
  , DictIntegral(..)
  , DictFractional(..)
  , DictFloating(..)
  , DictRealFrac(..)
  , DictRealFloat(..)
  , DictBits(..)
  , DictFiniteBits(..)
  , DictIx(..)
  , DictFunctor(..)
  , DictContravariant(..)
  , DictApplicative(..)
  , DictAlternative(..)
  , DictMonad(..)
  , DictMonadFail(..)
  , DictMonadPlus(..)
  , DictMonadFix(..)
  , DictFoldable(..)
  , DictTraversable(..)
  , DictBifunctor(..)
  , DictBifoldable(..)
  , DictBitraversable(..)
  , DictException(..)
  , DictCategory(..)
  , DictArrow(..)
  , DictArrowZero(..)
  , DictArrowPlus(..)
  , DictArrowChoice(..)
  , DictArrowApply(..)
  , DictArrowLoop(..)
  , DictStorable(..)

    -- * Default dictionaries
  , fmapFunctor
  , viaFunctor
  , applyApplicative
  , liftA2Applicative
  , bindMonad
  , joinMonad
  ) where

import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Exception
import Control.Category (Category)
import Data.Bits
import Data.Coerce
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Functor.Contravariant
import Data.Ix
import Foreign.Storable

import FCI

mkDict ''Eq
mkDict ''Ord
mkDict ''Semigroup
mkDict ''Monoid
mkDict ''Show
mkDict ''Read
mkDict ''Enum
mkDict ''Bounded
mkDict ''Num
mkDict ''Real
mkDict ''Integral
mkDict ''Fractional
mkDict ''Floating
mkDict ''RealFrac
mkDict ''RealFloat
mkDict ''Bits
mkDict ''FiniteBits
mkDict ''Ix
mkDict ''Functor
mkDict ''Contravariant
mkDict ''Applicative
mkDict ''Alternative
mkDict ''Monad
mkDict ''MonadFail
mkDict ''MonadPlus
mkDict ''MonadFix
mkDict ''Foldable
mkDict ''Traversable
mkDict ''Bifunctor
mkDict ''Bifoldable
mkDict ''Bitraversable
mkDict ''Exception
mkDict ''Category
mkDict ''Arrow
mkDict ''ArrowZero
mkDict ''ArrowPlus
mkDict ''ArrowChoice
mkDict ''ArrowApply
mkDict ''ArrowLoop
mkDict ''Storable

-------------------------------------------------------------------------------
-- | Default t'Functor' dictionary requiring only 'fmap'.
fmapFunctor :: (forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
fmapFunctor :: forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
fmapFunctor forall a b. (a -> b) -> f a -> f b
_fmap = Functor{
    (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
_fmap :: forall a b. (a -> b) -> f a -> f b
_fmap :: forall a b. (a -> b) -> f a -> f b
_fmap
  , |<$ :: forall a b. a -> f b -> f a
(|<$) = (b -> a) -> f b -> f a
forall a b. (a -> b) -> f a -> f b
_fmap ((b -> a) -> f b -> f a) -> (a -> b -> a) -> a -> f b -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> a
forall a b. a -> b -> a
const
  }

-------------------------------------------------------------------------------
-- | t'Functor' dictionary for a type coercible to another that has a t'Functor'
-- instance.
--
-- This definition is actually quite limited in applicability.
-- A better definition would use the quantified constraint
-- @(forall a. Coercible (f a) (g a))@.
viaFunctor :: forall f g. (Coercible f g, Functor f) => Dict (Functor g)
viaFunctor :: forall (f :: * -> *) (g :: * -> *).
(Coercible f g, Functor f) =>
Dict (Functor g)
viaFunctor = Functor {
    _fmap :: forall a b. (a -> b) -> g a -> g b
_fmap = (((a -> b) -> f a -> f b) -> (a -> b) -> g a -> g b
forall {a} {b}. ((a -> b) -> f a -> f b) -> (a -> b) -> g a -> g b
forall a b. Coercible a b => a -> b
coerce :: ((a -> b) -> f a -> f b) -> (a -> b) -> g a -> g b) (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  , |<$ :: forall a b. a -> g b -> g a
(|<$) = ((a -> f b -> f a) -> a -> g b -> g a
forall {a} {b}. (a -> f b -> f a) -> a -> g b -> g a
forall a b. Coercible a b => a -> b
coerce :: (a -> f b -> f a) -> a -> g b -> g a) a -> f b -> f a
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$)
  }

-------------------------------------------------------------------------------
-- | Default t'Applicative' dictionary requiring only 'pure' and @('<*>')@.
applyApplicative :: (forall a. a -> f a)                    -- ^ 'pure'
                 -> (forall a b. f (a -> b) -> f a -> f b)  -- ^ ('<*>')
                 -> Dict (Applicative f)
applyApplicative :: forall (f :: * -> *).
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b) -> Dict (Applicative f)
applyApplicative forall a. a -> f a
_pure forall a b. f (a -> b) -> f a -> f b
(|<*>) = Applicative{
    _Functor :: Dict (Functor f)
_Functor = (forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
fmapFunctor ((forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f))
-> (forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
forall a b. (a -> b) -> a -> b
$ f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
(|<*>) (f (a -> b) -> f a -> f b)
-> ((a -> b) -> f (a -> b)) -> (a -> b) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f (a -> b)
forall a. a -> f a
_pure
  , a -> f a
forall a. a -> f a
_pure :: forall a. a -> f a
_pure :: forall a. a -> f a
_pure
  , f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
|<*> :: forall a b. f (a -> b) -> f a -> f b
|<*> :: forall a b. f (a -> b) -> f a -> f b
(|<*>)
  , _liftA2 :: forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2  = \a -> b -> c
f f a
fa f b
fb -> (a -> b -> c) -> f (a -> b -> c)
forall a. a -> f a
_pure a -> b -> c
f f (a -> b -> c) -> f a -> f (b -> c)
forall a b. f (a -> b) -> f a -> f b
|<*> f a
fa f (b -> c) -> f b -> f c
forall a b. f (a -> b) -> f a -> f b
|<*> f b
fb
  , |*> :: forall a b. f a -> f b -> f b
(|*>)    = \f a
fa f b
fb -> (a -> b -> b) -> f (a -> b -> b)
forall a. a -> f a
_pure ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id) f (a -> b -> b) -> f a -> f (b -> b)
forall a b. f (a -> b) -> f a -> f b
|<*> f a
fa f (b -> b) -> f b -> f b
forall a b. f (a -> b) -> f a -> f b
|<*> f b
fb
  , |<* :: forall a b. f a -> f b -> f a
(|<*)    = \f a
fa f b
fb -> (a -> b -> a) -> f (a -> b -> a)
forall a. a -> f a
_pure a -> b -> a
forall a b. a -> b -> a
const f (a -> b -> a) -> f a -> f (b -> a)
forall a b. f (a -> b) -> f a -> f b
|<*> f a
fa f (b -> a) -> f b -> f a
forall a b. f (a -> b) -> f a -> f b
|<*> f b
fb
  }

-------------------------------------------------------------------------------
-- | Default t'Applicative' dictionary requiring only 'pure' and 'liftA2'.
liftA2Applicative :: (forall a. a -> f a)
                  -- ^ 'pure'
                  -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
                  -- ^ 'Control.Applicative.liftA2'
                  -> Dict (Applicative f)
liftA2Applicative :: forall (f :: * -> *).
(forall a. a -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Dict (Applicative f)
liftA2Applicative forall a. a -> f a
_pure forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 = Applicative{
    _Functor :: Dict (Functor f)
_Functor = (forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
fmapFunctor ((forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f))
-> (forall a b. (a -> b) -> f a -> f b) -> Dict (Functor f)
forall a b. (a -> b) -> a -> b
$ ((f () -> f a -> f b) -> f () -> f a -> f b
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall a. a -> f a
_pure ()) ((f () -> f a -> f b) -> f a -> f b)
-> ((a -> b) -> f () -> f a -> f b) -> (a -> b) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> a -> b) -> f () -> f a -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 ((() -> a -> b) -> f () -> f a -> f b)
-> ((a -> b) -> () -> a -> b) -> (a -> b) -> f () -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> () -> a -> b
forall a b. a -> b -> a
const
  , a -> f a
forall a. a -> f a
_pure :: forall a. a -> f a
_pure :: forall a. a -> f a
_pure
  , |<*> :: forall a b. f (a -> b) -> f a -> f b
(|<*>)   = ((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
  , (a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 :: forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 :: forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2
  , |*> :: forall a b. f a -> f b -> f b
(|*>)    = (a -> b -> b) -> f a -> f b -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 ((a -> b -> b) -> f a -> f b -> f b)
-> (a -> b -> b) -> f a -> f b -> f b
forall a b. (a -> b) -> a -> b
$ (b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id
  , |<* :: forall a b. f a -> f b -> f a
(|<*)    = (a -> b -> a) -> f a -> f b -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
_liftA2 a -> b -> a
forall a b. a -> b -> a
const
  }

-------------------------------------------------------------------------------
-- | Default t'Monad' dictionary requiring only 'return' and @('>>=')@.
bindMonad :: (forall a. a -> m a)                    -- ^ 'return'
          -> (forall a b. m a -> (a -> m b) -> m b)  -- ^ ('>>=')
          -> Dict (Monad m)
bindMonad :: forall (m :: * -> *).
(forall a. a -> m a)
-> (forall a b. m a -> (a -> m b) -> m b) -> Dict (Monad m)
bindMonad forall a. a -> m a
_return forall a b. m a -> (a -> m b) -> m b
(|>>=) = Monad{
    _Applicative :: Dict (Applicative m)
_Applicative = (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b) -> Dict (Applicative m)
forall (f :: * -> *).
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b) -> Dict (Applicative f)
applyApplicative a -> m a
forall a. a -> m a
_return \m (a -> b)
mf m a
ma ->
                     m (a -> b)
mf m (a -> b) -> ((a -> b) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
|>>= \a -> b
f -> m a
ma m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
|>>= \a
a -> b -> m b
forall a. a -> m a
_return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  , m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
|>>= :: forall a b. m a -> (a -> m b) -> m b
|>>= :: forall a b. m a -> (a -> m b) -> m b
(|>>=)
  , |>> :: forall a b. m a -> m b -> m b
(|>>)        = \m a
ma -> (m a
ma m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
|>>=) ((a -> m b) -> m b) -> (m b -> a -> m b) -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> a -> m b
forall a b. a -> b -> a
const
  , a -> m a
forall a. a -> m a
_return :: forall a. a -> m a
_return :: forall a. a -> m a
_return
#if !MIN_VERSION_GLASGOW_HASKELL(8,8,0,0)
  , _fail        = error
#endif
  }

-------------------------------------------------------------------------------
-- | Default t'Monad' dictionary requiring only 'fmap', 'return', and 'Control.Monad.join'.
joinMonad :: (forall a b. (a -> b) -> m a -> m b)  -- ^ 'fmap'
          -> (forall a. a -> m a)                  -- ^ 'return'
          -> (forall a. m (m a) -> m a)            -- ^ 'Control.Monad.join'
          -> Dict (Monad m)
joinMonad :: forall (m :: * -> *).
(forall a b. (a -> b) -> m a -> m b)
-> (forall a. a -> m a)
-> (forall a. m (m a) -> m a)
-> Dict (Monad m)
joinMonad forall a b. (a -> b) -> m a -> m b
_fmap forall a. a -> m a
_return forall a. m (m a) -> m a
_join = Monad{
    _Applicative :: Dict (Applicative m)
_Applicative = (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b) -> Dict (Applicative m)
forall (f :: * -> *).
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b) -> Dict (Applicative f)
applyApplicative a -> m a
forall a. a -> m a
_return \m (a -> b)
mf m a
ma ->
                     m (m b) -> m b
forall a. m (m a) -> m a
_join (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> m b) -> m (a -> b) -> m (m b)
forall a b. (a -> b) -> m a -> m b
_fmap ((a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
`_fmap` m a
ma) m (a -> b)
mf
  , |>>= :: forall a b. m a -> (a -> m b) -> m b
(|>>=)       = \m a
ma -> m (m b) -> m b
forall a. m (m a) -> m a
_join (m (m b) -> m b) -> ((a -> m b) -> m (m b)) -> (a -> m b) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m b) -> m a -> m (m b)) -> m a -> (a -> m b) -> m (m b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> m a -> m (m b)
forall a b. (a -> b) -> m a -> m b
_fmap m a
ma
  , |>> :: forall a b. m a -> m b -> m b
(|>>)        = \m a
ma -> m (m b) -> m b
forall a. m (m a) -> m a
_join (m (m b) -> m b) -> (m b -> m (m b)) -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> m b) -> m a -> m (m b)) -> m a -> (a -> m b) -> m (m b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> m a -> m (m b)
forall a b. (a -> b) -> m a -> m b
_fmap m a
ma ((a -> m b) -> m (m b)) -> (m b -> a -> m b) -> m b -> m (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> a -> m b
forall a b. a -> b -> a
const
  , a -> m a
forall a. a -> m a
_return :: forall a. a -> m a
_return :: forall a. a -> m a
_return
#if !MIN_VERSION_GLASGOW_HASKELL(8,8,0,0)
  , _fail        = error
#endif
  }