{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  polykinds
--
----------------------------------------------------------------------------

module Data.Semigroupoid.Static
  ( Static(..)
  ) where

import Control.Arrow
import Control.Applicative
import Control.Category
import Control.Monad (ap)
import Data.Functor.Apply
import Data.Functor.Plus
import Data.Functor.Extend
import Data.Orphans ()
import Data.Semigroup
import Data.Semigroupoid
import Prelude hiding ((.), id)

#ifdef MIN_VERSION_comonad
import Control.Comonad
#endif

newtype Static f a b = Static { forall (f :: * -> *) a b. Static f a b -> f (a -> b)
runStatic :: f (a -> b) }

instance Functor f => Functor (Static f a) where
  fmap :: forall a b. (a -> b) -> Static f a a -> Static f a b
fmap a -> b
f = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Static f a b -> f (a -> b)
runStatic

instance Apply f => Apply (Static f a) where
  Static f (a -> a -> b)
f <.> :: forall a b. Static f a (a -> b) -> Static f a a -> Static f a b
<.> Static f (a -> a)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> a -> b)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (a -> a)
g)

instance Alt f => Alt (Static f a) where
  Static f (a -> a)
f <!> :: forall a. Static f a a -> Static f a a -> Static f a a
<!> Static f (a -> a)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (f (a -> a)
f forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f (a -> a)
g)

instance Plus f => Plus (Static f a) where
  zero :: forall a. Static f a a
zero = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall (f :: * -> *) a. Plus f => f a
zero

instance Applicative f => Applicative (Static f a) where
  pure :: forall a. a -> Static f a a
pure = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const
  Static f (a -> a -> b)
f <*> :: forall a b. Static f a (a -> b) -> Static f a a -> Static f a b
<*> Static f (a -> a)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a -> a)
g)

instance (Extend f, Semigroup a) => Extend (Static f a) where
  extended :: forall a b. (Static f a a -> b) -> Static f a a -> Static f a b
extended Static f a a -> b
f = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (\f (a -> a)
wf a
m -> Static f a a -> b
f (forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Semigroup a => a -> a -> a
(<>) a
m) f (a -> a)
wf))) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Static f a b -> f (a -> b)
runStatic

#ifdef MIN_VERSION_comonad
instance (Comonad f, Monoid a) => Comonad (Static f a) where
  extend :: forall a b. (Static f a a -> b) -> Static f a a -> Static f a b
extend Static f a a -> b
f = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\f (a -> a)
wf a
m -> Static f a a -> b
f (forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Monoid a => a -> a -> a
mappend a
m) f (a -> a)
wf))) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Static f a b -> f (a -> b)
runStatic
  extract :: forall a. Static f a a -> a
extract (Static f (a -> a)
g) = forall (w :: * -> *) a. Comonad w => w a -> a
extract f (a -> a)
g forall a. Monoid a => a
mempty
#endif

instance Apply f => Semigroupoid (Static f) where
  Static f (j -> k)
f o :: forall j k i. Static f j k -> Static f i j -> Static f i k
`o` Static f (i -> j)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (j -> k)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (i -> j)
g)

instance Applicative f => Category (Static f) where
  id :: forall a. Static f a a
id = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  Static f (b -> c)
f . :: forall b c a. Static f b c -> Static f a b -> Static f a c
. Static f (a -> b)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a -> b)
g)

instance Applicative f => Arrow (Static f) where
  arr :: forall b c. (b -> c) -> Static f b c
arr = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  first :: forall b c d. Static f b c -> Static f (b, d) (c, d)
first (Static f (b -> c)
g) = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g)
  second :: forall b c d. Static f b c -> Static f (d, b) (d, c)
second (Static f (b -> c)
g) = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g)
  Static f (b -> c)
g *** :: forall b c b' c'.
Static f b c -> Static f b' c' -> Static f (b, b') (c, c')
*** Static f (b' -> c')
h = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (b' -> c')
h)
  Static f (b -> c)
g &&& :: forall b c c'. Static f b c -> Static f b c' -> Static f b (c, c')
&&& Static f (b -> c')
h = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (b -> c')
h)

instance Alternative f => ArrowZero (Static f) where
  zeroArrow :: forall b c. Static f b c
zeroArrow = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static forall (f :: * -> *) a. Alternative f => f a
empty

instance Alternative f => ArrowPlus (Static f) where
  Static f (b -> c)
f <+> :: forall b c. Static f b c -> Static f b c -> Static f b c
<+> Static f (b -> c)
g = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (f (b -> c)
f forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f (b -> c)
g)

instance Applicative f => ArrowChoice (Static f) where
  left :: forall b c d. Static f b c -> Static f (Either b d) (Either c d)
left (Static f (b -> c)
g) = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g)
  right :: forall b c d. Static f b c -> Static f (Either d b) (Either d c)
right (Static f (b -> c)
g) = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g)
  Static f (b -> c)
g +++ :: forall b c b' c'.
Static f b c
-> Static f b' c' -> Static f (Either b b') (Either c c')
+++ Static f (b' -> c')
h = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (b' -> c')
h)
  Static f (b -> d)
g ||| :: forall b d c.
Static f b d -> Static f c d -> Static f (Either b c) d
||| Static f (c -> d)
h = forall (f :: * -> *) a b. f (a -> b) -> Static f a b
Static (forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> d)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (c -> d)
h)