about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs')
-rw-r--r--third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs154
1 files changed, 154 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs
new file mode 100644
index 0000000000..ed781309af
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Compose
+-- Copyright   :  (c) Ross Paterson 2010
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Composition of functors.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Compose (
+    Compose(..),
+  ) where
+
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+
+import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+infixr 9 `Compose`
+
+-- | Right-to-left composition of functors.
+-- The composition of applicative functors is always applicative,
+-- but the composition of monads is not always a monad.
+newtype Compose f g a = Compose { getCompose :: f (g a) }
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Compose f g a)
+
+instance Functor f => Generic1 (Compose f g) where
+    type Rep1 (Compose f g) =
+      D1 MDCompose
+        (C1 MCCompose
+          (S1 MSCompose (f :.: Rec1 g)))
+    from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
+    to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x))
+
+data MDCompose
+data MCCompose
+data MSCompose
+
+instance Datatype MDCompose where
+    datatypeName _ = "Compose"
+    moduleName   _ = "Data.Functor.Compose"
+# if __GLASGOW_HASKELL__ >= 708
+    isNewtype    _ = True
+# endif
+
+instance Constructor MCCompose where
+    conName     _ = "Compose"
+    conIsRecord _ = True
+
+instance Selector MSCompose where
+    selName _ = "getCompose"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Compose
+deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a)
+               => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
+-- Instances of lifted Prelude classes
+
+instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where
+    liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y
+
+instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where
+    liftCompare comp (Compose x) (Compose y) =
+        liftCompare (liftCompare comp) x y
+
+instance (Read1 f, Read1 g) => Read1 (Compose f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+
+instance (Show1 f, Show1 g) => Show1 (Compose f g) where
+    liftShowsPrec sp sl d (Compose x) =
+        showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+-- Instances of Prelude classes
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where
+    (==) = eq1
+
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where
+    compare = compare1
+
+instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where
+    readsPrec = readsPrec1
+
+instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where
+    showsPrec = showsPrec1
+
+-- Functor instances
+
+instance (Functor f, Functor g) => Functor (Compose f g) where
+    fmap f (Compose x) = Compose (fmap (fmap f) x)
+
+instance (Foldable f, Foldable g) => Foldable (Compose f g) where
+    foldMap f (Compose t) = foldMap (foldMap f) t
+
+instance (Traversable f, Traversable g) => Traversable (Compose f g) where
+    traverse f (Compose t) = Compose <$> traverse (traverse f) t
+
+instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+    pure x = Compose (pure (pure x))
+    Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
+
+instance (Alternative f, Applicative g) => Alternative (Compose f g) where
+    empty = Compose empty
+    Compose x <|> Compose y = Compose (x <|> y)
+
+#if MIN_VERSION_base(4,12,0)
+instance (Functor f, Contravariant g) => Contravariant (Compose f g) where
+    contramap f (Compose fga) = Compose (fmap (contramap f) fga)
+#endif