{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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 LANGUAGE_DeriveDataTypeable import Data.Typeable #endif #ifdef MIN_VERSION_comonad import Control.Comonad #endif newtype Static f a b = Static { Static f a b -> f (a -> b) runStatic :: f (a -> b) } #ifdef LANGUAGE_DeriveDataTypeable deriving (Typeable) #endif instance Functor f => Functor (Static f a) where fmap :: (a -> b) -> Static f a a -> Static f a b fmap a -> b f = f (a -> b) -> Static f a b forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (a -> b) -> Static f a b) -> (Static f a a -> f (a -> b)) -> Static f a a -> Static f a b forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . ((a -> a) -> a -> b) -> f (a -> a) -> f (a -> b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a -> b f (a -> b) -> (a -> a) -> a -> b forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c .) (f (a -> a) -> f (a -> b)) -> (Static f a a -> f (a -> a)) -> Static f a a -> f (a -> b) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Static f a a -> f (a -> a) 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 <.> :: Static f a (a -> b) -> Static f a a -> Static f a b <.> Static f (a -> a) g = f (a -> b) -> Static f a b forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((a -> a -> b) -> (a -> a) -> a -> b forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b ap ((a -> a -> b) -> (a -> a) -> a -> b) -> f (a -> a -> b) -> f ((a -> a) -> a -> b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (a -> a -> b) f f ((a -> a) -> a -> b) -> f (a -> a) -> f (a -> b) 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 <!> :: Static f a a -> Static f a a -> Static f a a <!> Static f (a -> a) g = f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (a -> a) f f (a -> a) -> f (a -> a) -> f (a -> a) forall (f :: * -> *) a. Alt f => f a -> f a -> f a <!> f (a -> a) g) instance Plus f => Plus (Static f a) where zero :: Static f a a zero = f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static f (a -> a) forall (f :: * -> *) a. Plus f => f a zero instance Applicative f => Applicative (Static f a) where pure :: a -> Static f a a pure = f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (a -> a) -> Static f a a) -> (a -> f (a -> a)) -> a -> Static f a a forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . (a -> a) -> f (a -> a) forall (f :: * -> *) a. Applicative f => a -> f a pure ((a -> a) -> f (a -> a)) -> (a -> a -> a) -> a -> f (a -> a) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> a -> a forall a b. a -> b -> a const Static f (a -> a -> b) f <*> :: Static f a (a -> b) -> Static f a a -> Static f a b <*> Static f (a -> a) g = f (a -> b) -> Static f a b forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((a -> a -> b) -> (a -> a) -> a -> b forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b ap ((a -> a -> b) -> (a -> a) -> a -> b) -> f (a -> a -> b) -> f ((a -> a) -> a -> b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (a -> a -> b) f f ((a -> a) -> a -> b) -> f (a -> a) -> f (a -> b) 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 :: (Static f a a -> b) -> Static f a a -> Static f a b extended Static f a a -> b f = f (a -> b) -> Static f a b forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (a -> b) -> Static f a b) -> (Static f a a -> f (a -> b)) -> Static f a a -> Static f a b forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . (f (a -> a) -> a -> b) -> f (a -> a) -> f (a -> b) 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 (f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (((a -> a) -> a -> a) -> f (a -> a) -> f (a -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> a) -> (a -> a) -> a -> a forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> a -> a forall a. Semigroup a => a -> a -> a (<>) a m) f (a -> a) wf))) (f (a -> a) -> f (a -> b)) -> (Static f a a -> f (a -> a)) -> Static f a a -> f (a -> b) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Static f a a -> f (a -> a) 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 :: (Static f a a -> b) -> Static f a a -> Static f a b extend Static f a a -> b f = f (a -> b) -> Static f a b forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (a -> b) -> Static f a b) -> (Static f a a -> f (a -> b)) -> Static f a a -> Static f a b forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . (f (a -> a) -> a -> b) -> f (a -> a) -> f (a -> b) 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 (f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (((a -> a) -> a -> a) -> f (a -> a) -> f (a -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> a) -> (a -> a) -> a -> a forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> a -> a forall a. Monoid a => a -> a -> a mappend a m) f (a -> a) wf))) (f (a -> a) -> f (a -> b)) -> (Static f a a -> f (a -> a)) -> Static f a a -> f (a -> b) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Static f a a -> f (a -> a) forall (f :: * -> *) a b. Static f a b -> f (a -> b) runStatic extract :: Static f a a -> a extract (Static f (a -> a) g) = f (a -> a) -> a -> a forall (w :: * -> *) a. Comonad w => w a -> a extract f (a -> a) g a forall a. Monoid a => a mempty #endif instance Apply f => Semigroupoid (Static f) where Static f (j -> k) f o :: Static f j k -> Static f i j -> Static f i k `o` Static f (i -> j) g = f (i -> k) -> Static f i k forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((j -> k) -> (i -> j) -> i -> k forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c (.) ((j -> k) -> (i -> j) -> i -> k) -> f (j -> k) -> f ((i -> j) -> i -> k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (j -> k) f f ((i -> j) -> i -> k) -> f (i -> j) -> f (i -> k) 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 :: Static f a a id = f (a -> a) -> Static f a a forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((a -> a) -> f (a -> a) forall (f :: * -> *) a. Applicative f => a -> f a pure a -> a forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a id) Static f (b -> c) f . :: Static f b c -> Static f a b -> Static f a c . Static f (a -> b) g = f (a -> c) -> Static f a c forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (a -> b) -> a -> c forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c (.) ((b -> c) -> (a -> b) -> a -> c) -> f (b -> c) -> f ((a -> b) -> a -> c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) f f ((a -> b) -> a -> c) -> f (a -> b) -> f (a -> c) 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 :: (b -> c) -> Static f b c arr = f (b -> c) -> Static f b c forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (b -> c) -> Static f b c) -> ((b -> c) -> f (b -> c)) -> (b -> c) -> Static f b c forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . (b -> c) -> f (b -> c) forall (f :: * -> *) a. Applicative f => a -> f a pure first :: Static f b c -> Static f (b, d) (c, d) first (Static f (b -> c) g) = f ((b, d) -> (c, d)) -> Static f (b, d) (c, d) forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first ((b -> c) -> (b, d) -> (c, d)) -> f (b -> c) -> f ((b, d) -> (c, d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g) second :: Static f b c -> Static f (d, b) (d, c) second (Static f (b -> c) g) = f ((d, b) -> (d, c)) -> Static f (d, b) (d, c) forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (d, b) -> (d, c) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (d, b) (d, c) second ((b -> c) -> (d, b) -> (d, c)) -> f (b -> c) -> f ((d, b) -> (d, c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g) Static f (b -> c) g *** :: Static f b c -> Static f b' c' -> Static f (b, b') (c, c') *** Static f (b' -> c') h = f ((b, b') -> (c, c')) -> Static f (b, b') (c, c') forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (b' -> c') -> (b, b') -> (c, c') forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') (***) ((b -> c) -> (b' -> c') -> (b, b') -> (c, c')) -> f (b -> c) -> f ((b' -> c') -> (b, b') -> (c, c')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g f ((b' -> c') -> (b, b') -> (c, c')) -> f (b' -> c') -> f ((b, b') -> (c, c')) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (b' -> c') h) Static f (b -> c) g &&& :: Static f b c -> Static f b c' -> Static f b (c, c') &&& Static f (b -> c') h = f (b -> (c, c')) -> Static f b (c, c') forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (b -> c') -> b -> (c, c') forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') (&&&) ((b -> c) -> (b -> c') -> b -> (c, c')) -> f (b -> c) -> f ((b -> c') -> b -> (c, c')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g f ((b -> c') -> b -> (c, c')) -> f (b -> c') -> f (b -> (c, c')) 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 :: Static f b c zeroArrow = f (b -> c) -> Static f b c forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static f (b -> c) forall (f :: * -> *) a. Alternative f => f a empty instance Alternative f => ArrowPlus (Static f) where Static f (b -> c) f <+> :: Static f b c -> Static f b c -> Static f b c <+> Static f (b -> c) g = f (b -> c) -> Static f b c forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static (f (b -> c) f f (b -> c) -> f (b -> c) -> f (b -> c) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> f (b -> c) g) instance Applicative f => ArrowChoice (Static f) where left :: Static f b c -> Static f (Either b d) (Either c d) left (Static f (b -> c) g) = f (Either b d -> Either c d) -> Static f (Either b d) (Either c d) forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> Either b d -> Either c d forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either b d) (Either c d) left ((b -> c) -> Either b d -> Either c d) -> f (b -> c) -> f (Either b d -> Either c d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g) right :: Static f b c -> Static f (Either d b) (Either d c) right (Static f (b -> c) g) = f (Either d b -> Either d c) -> Static f (Either d b) (Either d c) forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> Either d b -> Either d c forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either d b) (Either d c) right ((b -> c) -> Either d b -> Either d c) -> f (b -> c) -> f (Either d b -> Either d c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g) Static f (b -> c) g +++ :: Static f b c -> Static f b' c' -> Static f (Either b b') (Either c c') +++ Static f (b' -> c') h = f (Either b b' -> Either c c') -> Static f (Either b b') (Either c c') forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> c) -> (b' -> c') -> Either b b' -> Either c c' forall (a :: * -> * -> *) b c b' c'. ArrowChoice a => a b c -> a b' c' -> a (Either b b') (Either c c') (+++) ((b -> c) -> (b' -> c') -> Either b b' -> Either c c') -> f (b -> c) -> f ((b' -> c') -> Either b b' -> Either c c') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> c) g f ((b' -> c') -> Either b b' -> Either c c') -> f (b' -> c') -> f (Either b b' -> Either c c') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (b' -> c') h) Static f (b -> d) g ||| :: Static f b d -> Static f c d -> Static f (Either b c) d ||| Static f (c -> d) h = f (Either b c -> d) -> Static f (Either b c) d forall (f :: * -> *) a b. f (a -> b) -> Static f a b Static ((b -> d) -> (c -> d) -> Either b c -> d forall (a :: * -> * -> *) b d c. ArrowChoice a => a b d -> a c d -> a (Either b c) d (|||) ((b -> d) -> (c -> d) -> Either b c -> d) -> f (b -> d) -> f ((c -> d) -> Either b c -> d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (b -> d) g f ((c -> d) -> Either b c -> d) -> f (c -> d) -> f (Either b c -> d) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (c -> d) h)