1{-# LANGUAGE CPP #-}
2
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
5#endif
6
7-----------------------------------------------------------------------------
8-- |
9-- Copyright   :  (C) 2011-2015 Edward Kmett
10-- License     :  BSD-style (see the file LICENSE)
11--
12-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
13-- Stability   :  provisional
14-- Portability :  polykinds
15--
16----------------------------------------------------------------------------
17
18module Data.Semigroupoid.Static
19  ( Static(..)
20  ) where
21
22import Control.Arrow
23import Control.Applicative
24import Control.Category
25import Control.Monad (ap)
26import Data.Functor.Apply
27import Data.Functor.Plus
28import Data.Functor.Extend
29import Data.Orphans ()
30import Data.Semigroup
31import Data.Semigroupoid
32import Prelude hiding ((.), id)
33
34#ifdef LANGUAGE_DeriveDataTypeable
35import Data.Typeable
36#endif
37
38#ifdef MIN_VERSION_comonad
39import Control.Comonad
40#endif
41
42newtype Static f a b = Static { runStatic :: f (a -> b) }
43#ifdef LANGUAGE_DeriveDataTypeable
44  deriving (Typeable)
45#endif
46
47instance Functor f => Functor (Static f a) where
48  fmap f = Static . fmap (f .) . runStatic
49
50instance Apply f => Apply (Static f a) where
51  Static f <.> Static g = Static (ap <$> f <.> g)
52
53instance Alt f => Alt (Static f a) where
54  Static f <!> Static g = Static (f <!> g)
55
56instance Plus f => Plus (Static f a) where
57  zero = Static zero
58
59instance Applicative f => Applicative (Static f a) where
60  pure = Static . pure . const
61  Static f <*> Static g = Static (ap <$> f <*> g)
62
63instance (Extend f, Semigroup a) => Extend (Static f a) where
64  extended f = Static . extended (\wf m -> f (Static (fmap (. (<>) m) wf))) . runStatic
65
66#ifdef MIN_VERSION_comonad
67instance (Comonad f, Monoid a) => Comonad (Static f a) where
68  extend f = Static . extend (\wf m -> f (Static (fmap (. mappend m) wf))) . runStatic
69  extract (Static g) = extract g mempty
70#endif
71
72instance Apply f => Semigroupoid (Static f) where
73  Static f `o` Static g = Static ((.) <$> f <.> g)
74
75instance Applicative f => Category (Static f) where
76  id = Static (pure id)
77  Static f . Static g = Static ((.) <$> f <*> g)
78
79instance Applicative f => Arrow (Static f) where
80  arr = Static . pure
81  first (Static g) = Static (first <$> g)
82  second (Static g) = Static (second <$> g)
83  Static g *** Static h = Static ((***) <$> g <*> h)
84  Static g &&& Static h = Static ((&&&) <$> g <*> h)
85
86instance Alternative f => ArrowZero (Static f) where
87  zeroArrow = Static empty
88
89instance Alternative f => ArrowPlus (Static f) where
90  Static f <+> Static g = Static (f <|> g)
91
92instance Applicative f => ArrowChoice (Static f) where
93  left (Static g) = Static (left <$> g)
94  right (Static g) = Static (right <$> g)
95  Static g +++ Static h = Static ((+++) <$> g <*> h)
96  Static g ||| Static h = Static ((|||) <$> g <*> h)
97
98