about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs')
-rw-r--r--third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs136
1 files changed, 136 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs
new file mode 100644
index 0000000000..e6d1428b30
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs
@@ -0,0 +1,136 @@
+{-# 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.Sum
+-- Copyright   :  (c) Ross Paterson 2014
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Sums, lifted to functors.
+-----------------------------------------------------------------------------
+
+module Data.Functor.Sum (
+    Sum(..),
+  ) where
+
+import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
+import Data.Foldable (Foldable(foldMap))
+import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
+import Data.Monoid (mappend)
+import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
+
+-- | Lifted sum of functors.
+data Sum f g a = InL (f a) | InR (g a)
+
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Sum f g a)
+
+instance Generic1 (Sum f g) where
+    type Rep1 (Sum f g) =
+      D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f))
+            :+: C1 MCInR (S1 NoSelector (Rec1 g)))
+    from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f))))
+    from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g))))
+    to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f)
+    to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g)
+
+data MDSum
+data MCInL
+data MCInR
+
+instance Datatype MDSum where
+    datatypeName _ = "Sum"
+    moduleName   _ = "Data.Functor.Sum"
+
+instance Constructor MCInL where
+    conName _ = "InL"
+
+instance Constructor MCInR where
+    conName _ = "InR"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Sum
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
+instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
+    liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2
+    liftEq _ (InL _) (InR _) = False
+    liftEq _ (InR _) (InL _) = False
+    liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2
+
+instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
+    liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2
+    liftCompare _ (InL _) (InR _) = LT
+    liftCompare _ (InR _) (InL _) = GT
+    liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2
+
+instance (Read1 f, Read1 g) => Read1 (Sum f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "InR" InR
+
+instance (Show1 f, Show1 g) => Show1 (Sum f g) where
+    liftShowsPrec sp sl d (InL x) =
+        showsUnaryWith (liftShowsPrec sp sl) "InL" d x
+    liftShowsPrec sp sl d (InR y) =
+        showsUnaryWith (liftShowsPrec sp sl) "InR" d y
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
+    (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
+    readsPrec = readsPrec1
+instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
+    showsPrec = showsPrec1
+
+instance (Functor f, Functor g) => Functor (Sum f g) where
+    fmap f (InL x) = InL (fmap f x)
+    fmap f (InR y) = InR (fmap f y)
+
+instance (Foldable f, Foldable g) => Foldable (Sum f g) where
+    foldMap f (InL x) = foldMap f x
+    foldMap f (InR y) = foldMap f y
+
+instance (Traversable f, Traversable g) => Traversable (Sum f g) where
+    traverse f (InL x) = InL <$> traverse f x
+    traverse f (InR y) = InR <$> traverse f y
+
+#if MIN_VERSION_base(4,12,0)
+instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where
+    contramap f (InL xs) = InL (contramap f xs)
+    contramap f (InR ys) = InR (contramap f ys)
+#endif