From f723b8b878a3c4a4687b9e337a875500bebb39b1 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Thu, 4 Jul 2019 11:18:12 +0100 Subject: feat(third_party/bazel): Check in rules_haskell from Tweag --- .../transformers/legacy/pre711/Data/Functor/Sum.hs | 136 +++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs (limited to 'third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs') 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 -- cgit 1.4.1