diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/Data')
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs | 152 | ||||
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs | 143 |
2 files changed, 295 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs new file mode 100644 index 0000000000..9c0b8d42dc --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Constant.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Safe #-} +#endif +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE PolyKinds #-} +#endif +#if __GLASGOW_HASKELL__ >= 710 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Functor.Constant +-- Copyright : (c) Ross Paterson 2010 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : R.Paterson@city.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- The constant functor. +----------------------------------------------------------------------------- + +module Data.Functor.Constant ( + Constant(..), + ) where + +import Data.Functor.Classes +#if MIN_VERSION_base(4,12,0) +import Data.Functor.Contravariant +#endif + +import Control.Applicative +import Data.Foldable +import Data.Monoid (Monoid(..)) +import Data.Traversable (Traversable(traverse)) +#if MIN_VERSION_base(4,8,0) +import Data.Bifunctor (Bifunctor(..)) +#endif +#if MIN_VERSION_base(4,9,0) +import Data.Semigroup (Semigroup(..)) +#endif +#if MIN_VERSION_base(4,10,0) +import Data.Bifoldable (Bifoldable(..)) +import Data.Bitraversable (Bitraversable(..)) +#endif +import Prelude hiding (null, length) + +-- | Constant functor. +newtype Constant a b = Constant { getConstant :: a } + deriving (Eq, Ord) + +-- These instances would be equivalent to the derived instances of the +-- newtype if the field were removed. + +instance (Read a) => Read (Constant a b) where + readsPrec = readsData $ + readsUnaryWith readsPrec "Constant" Constant + +instance (Show a) => Show (Constant a b) where + showsPrec d (Constant x) = showsUnaryWith showsPrec "Constant" d x + +-- Instances of lifted Prelude classes + +instance Eq2 Constant where + liftEq2 eq _ (Constant x) (Constant y) = eq x y + {-# INLINE liftEq2 #-} + +instance Ord2 Constant where + liftCompare2 comp _ (Constant x) (Constant y) = comp x y + {-# INLINE liftCompare2 #-} + +instance Read2 Constant where + liftReadsPrec2 rp _ _ _ = readsData $ + readsUnaryWith rp "Constant" Constant + +instance Show2 Constant where + liftShowsPrec2 sp _ _ _ d (Constant x) = showsUnaryWith sp "Constant" d x + +instance (Eq a) => Eq1 (Constant a) where + liftEq = liftEq2 (==) + {-# INLINE liftEq #-} +instance (Ord a) => Ord1 (Constant a) where + liftCompare = liftCompare2 compare + {-# INLINE liftCompare #-} +instance (Read a) => Read1 (Constant a) where + liftReadsPrec = liftReadsPrec2 readsPrec readList + {-# INLINE liftReadsPrec #-} +instance (Show a) => Show1 (Constant a) where + liftShowsPrec = liftShowsPrec2 showsPrec showList + {-# INLINE liftShowsPrec #-} + +instance Functor (Constant a) where + fmap _ (Constant x) = Constant x + {-# INLINE fmap #-} + +instance Foldable (Constant a) where + foldMap _ (Constant _) = mempty + {-# INLINE foldMap #-} +#if MIN_VERSION_base(4,8,0) + null (Constant _) = True + length (Constant _) = 0 +#endif + +instance Traversable (Constant a) where + traverse _ (Constant x) = pure (Constant x) + {-# INLINE traverse #-} + +#if MIN_VERSION_base(4,9,0) +instance (Semigroup a) => Semigroup (Constant a b) where + Constant x <> Constant y = Constant (x <> y) + {-# INLINE (<>) #-} +#endif + +instance (Monoid a) => Applicative (Constant a) where + pure _ = Constant mempty + {-# INLINE pure #-} + Constant x <*> Constant y = Constant (x `mappend` y) + {-# INLINE (<*>) #-} + +instance (Monoid a) => Monoid (Constant a b) where + mempty = Constant mempty + {-# INLINE mempty #-} +#if !MIN_VERSION_base(4,11,0) + -- From base-4.11, Monoid(mappend) defaults to Semigroup((<>)) + Constant x `mappend` Constant y = Constant (x `mappend` y) + {-# INLINE mappend #-} +#endif + +#if MIN_VERSION_base(4,8,0) +instance Bifunctor Constant where + first f (Constant x) = Constant (f x) + {-# INLINE first #-} + second _ (Constant x) = Constant x + {-# INLINE second #-} +#endif + +#if MIN_VERSION_base(4,10,0) +instance Bifoldable Constant where + bifoldMap f _ (Constant a) = f a + {-# INLINE bifoldMap #-} + +instance Bitraversable Constant where + bitraverse f _ (Constant a) = Constant <$> f a + {-# INLINE bitraverse #-} +#endif + +#if MIN_VERSION_base(4,12,0) +instance Contravariant (Constant a) where + contramap _ (Constant a) = Constant a + {-# INLINE contramap #-} +#endif diff --git a/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs new file mode 100644 index 0000000000..5d8c41fa15 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/transformers/Data/Functor/Reverse.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Safe #-} +#endif +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE PolyKinds #-} +#endif +#if __GLASGOW_HASKELL__ >= 710 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Functor.Reverse +-- Copyright : (c) Russell O'Connor 2009 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : R.Paterson@city.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Making functors whose elements are notionally in the reverse order +-- from the original functor. +----------------------------------------------------------------------------- + +module Data.Functor.Reverse ( + Reverse(..), + ) where + +import Control.Applicative.Backwards +import Data.Functor.Classes +#if MIN_VERSION_base(4,12,0) +import Data.Functor.Contravariant +#endif + +import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length) +import Control.Applicative +import Control.Monad +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#endif +import Data.Foldable +import Data.Traversable +import Data.Monoid + +-- | The same functor, but with 'Foldable' and 'Traversable' instances +-- that process the elements in the reverse order. +newtype Reverse f a = Reverse { getReverse :: f a } + +instance (Eq1 f) => Eq1 (Reverse f) where + liftEq eq (Reverse x) (Reverse y) = liftEq eq x y + {-# INLINE liftEq #-} + +instance (Ord1 f) => Ord1 (Reverse f) where + liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y + {-# INLINE liftCompare #-} + +instance (Read1 f) => Read1 (Reverse f) where + liftReadsPrec rp rl = readsData $ + readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse + +instance (Show1 f) => Show1 (Reverse f) where + liftShowsPrec sp sl d (Reverse x) = + showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x + +instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1 +instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1 +instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1 +instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1 + +-- | Derived instance. +instance (Functor f) => Functor (Reverse f) where + fmap f (Reverse a) = Reverse (fmap f a) + {-# INLINE fmap #-} + +-- | Derived instance. +instance (Applicative f) => Applicative (Reverse f) where + pure a = Reverse (pure a) + {-# INLINE pure #-} + Reverse f <*> Reverse a = Reverse (f <*> a) + {-# INLINE (<*>) #-} + +-- | Derived instance. +instance (Alternative f) => Alternative (Reverse f) where + empty = Reverse empty + {-# INLINE empty #-} + Reverse x <|> Reverse y = Reverse (x <|> y) + {-# INLINE (<|>) #-} + +-- | Derived instance. +instance (Monad m) => Monad (Reverse m) where +#if !(MIN_VERSION_base(4,8,0)) + return a = Reverse (return a) + {-# INLINE return #-} +#endif + m >>= f = Reverse (getReverse m >>= getReverse . f) + {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0)) + fail msg = Reverse (fail msg) + {-# INLINE fail #-} +#endif + +#if MIN_VERSION_base(4,9,0) +instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where + fail msg = Reverse (Fail.fail msg) + {-# INLINE fail #-} +#endif + +-- | Derived instance. +instance (MonadPlus m) => MonadPlus (Reverse m) where + mzero = Reverse mzero + {-# INLINE mzero #-} + Reverse x `mplus` Reverse y = Reverse (x `mplus` y) + {-# INLINE mplus #-} + +-- | Fold from right to left. +instance (Foldable f) => Foldable (Reverse f) where + foldMap f (Reverse t) = getDual (foldMap (Dual . f) t) + {-# INLINE foldMap #-} + foldr f z (Reverse t) = foldl (flip f) z t + {-# INLINE foldr #-} + foldl f z (Reverse t) = foldr (flip f) z t + {-# INLINE foldl #-} + foldr1 f (Reverse t) = foldl1 (flip f) t + {-# INLINE foldr1 #-} + foldl1 f (Reverse t) = foldr1 (flip f) t + {-# INLINE foldl1 #-} +#if MIN_VERSION_base(4,8,0) + null (Reverse t) = null t + length (Reverse t) = length t +#endif + +-- | Traverse from right to left. +instance (Traversable f) => Traversable (Reverse f) where + traverse f (Reverse t) = + fmap Reverse . forwards $ traverse (Backwards . f) t + {-# INLINE traverse #-} + +#if MIN_VERSION_base(4,12,0) +-- | Derived instance. +instance Contravariant f => Contravariant (Reverse f) where + contramap f = Reverse . contramap f . getReverse + {-# INLINE contramap #-} +#endif |