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