diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/legacy/pre711')
5 files changed, 0 insertions, 1026 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs deleted file mode 100644 index 7c74d4ef0d..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Control/Monad/IO/Class.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Control.Monad.IO.Class --- Copyright : (c) Andy Gill 2001, --- (c) Oregon Graduate Institute of Science and Technology, 2001 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Class of monads based on @IO@. ------------------------------------------------------------------------------ - -module Control.Monad.IO.Class ( - MonadIO(..) - ) where - -#if __GLASGOW_HASKELL__ >= 708 -import Data.Typeable -#endif - --- | Monads in which 'IO' computations may be embedded. --- Any monad built by applying a sequence of monad transformers to the --- 'IO' monad will be an instance of this class. --- --- Instances should satisfy the following laws, which state that 'liftIO' --- is a transformer of monads: --- --- * @'liftIO' . 'return' = 'return'@ --- --- * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@ - -class (Monad m) => MonadIO m where - -- | Lift a computation from the 'IO' monad. - liftIO :: IO a -> m a - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable MonadIO -#endif - -instance MonadIO IO where - liftIO = id diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs deleted file mode 100644 index bda1749643..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Classes.hs +++ /dev/null @@ -1,529 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Safe #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Functor.Classes --- Copyright : (c) Ross Paterson 2013 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to --- unary and binary type constructors. --- --- These classes are needed to express the constraints on arguments of --- transformers in portable Haskell. Thus for a new transformer @T@, --- one might write instances like --- --- > instance (Eq1 f) => Eq1 (T f) where ... --- > instance (Ord1 f) => Ord1 (T f) where ... --- > instance (Read1 f) => Read1 (T f) where ... --- > instance (Show1 f) => Show1 (T f) where ... --- --- If these instances can be defined, defining instances of the base --- classes is mechanical: --- --- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1 --- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1 --- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1 --- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1 --- ------------------------------------------------------------------------------ - -module Data.Functor.Classes ( - -- * Liftings of Prelude classes - -- ** For unary constructors - Eq1(..), eq1, - Ord1(..), compare1, - Read1(..), readsPrec1, - Show1(..), showsPrec1, - -- ** For binary constructors - Eq2(..), eq2, - Ord2(..), compare2, - Read2(..), readsPrec2, - Show2(..), showsPrec2, - -- * Helper functions - -- $example - readsData, - readsUnaryWith, - readsBinaryWith, - showsUnaryWith, - showsBinaryWith, - -- ** Obsolete helpers - readsUnary, - readsUnary1, - readsBinary1, - showsUnary, - showsUnary1, - showsBinary1, - ) where - -import Control.Applicative (Const(Const)) -import Data.Functor.Identity (Identity(Identity)) -import Data.Monoid (mappend) -#if MIN_VERSION_base(4,7,0) -import Data.Proxy (Proxy(Proxy)) -#endif -#if __GLASGOW_HASKELL__ >= 708 -import Data.Typeable -#endif -import Text.Show (showListWith) - --- | Lifting of the 'Eq' class to unary type constructors. -class Eq1 f where - -- | Lift an equality test through the type constructor. - -- - -- The function will usually be applied to an equality function, - -- but the more general type ensures that the implementation uses - -- it to compare elements of the first container with elements of - -- the second. - liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Eq1 -#endif - --- | Lift the standard @('==')@ function through the type constructor. -eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool -eq1 = liftEq (==) - --- | Lifting of the 'Ord' class to unary type constructors. -class (Eq1 f) => Ord1 f where - -- | Lift a 'compare' function through the type constructor. - -- - -- The function will usually be applied to a comparison function, - -- but the more general type ensures that the implementation uses - -- it to compare elements of the first container with elements of - -- the second. - liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Ord1 -#endif - --- | Lift the standard 'compare' function through the type constructor. -compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering -compare1 = liftCompare compare - --- | Lifting of the 'Read' class to unary type constructors. -class Read1 f where - -- | 'readsPrec' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument type. - liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a) - - -- | 'readList' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument type. - -- The default implementation using standard list syntax is correct - -- for most types. - liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a] - liftReadList rp rl = readListWith (liftReadsPrec rp rl 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Read1 -#endif - --- | Read a list (using square brackets and commas), given a function --- for reading elements. -readListWith :: ReadS a -> ReadS [a] -readListWith rp = - readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s]) - where - readl s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t] - readl' s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u] - --- | Lift the standard 'readsPrec' and 'readList' functions through the --- type constructor. -readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a) -readsPrec1 = liftReadsPrec readsPrec readList - --- | Lifting of the 'Show' class to unary type constructors. -class Show1 f where - -- | 'showsPrec' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument type. - liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - Int -> f a -> ShowS - - -- | 'showList' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument type. - -- The default implementation using standard list syntax is correct - -- for most types. - liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - [f a] -> ShowS - liftShowList sp sl = showListWith (liftShowsPrec sp sl 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Show1 -#endif - --- | Lift the standard 'showsPrec' and 'showList' functions through the --- type constructor. -showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS -showsPrec1 = liftShowsPrec showsPrec showList - --- | Lifting of the 'Eq' class to binary type constructors. -class Eq2 f where - -- | Lift equality tests through the type constructor. - -- - -- The function will usually be applied to equality functions, - -- but the more general type ensures that the implementation uses - -- them to compare elements of the first container with elements of - -- the second. - liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Eq2 -#endif - --- | Lift the standard @('==')@ function through the type constructor. -eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool -eq2 = liftEq2 (==) (==) - --- | Lifting of the 'Ord' class to binary type constructors. -class (Eq2 f) => Ord2 f where - -- | Lift 'compare' functions through the type constructor. - -- - -- The function will usually be applied to comparison functions, - -- but the more general type ensures that the implementation uses - -- them to compare elements of the first container with elements of - -- the second. - liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) -> - f a c -> f b d -> Ordering - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Ord2 -#endif - --- | Lift the standard 'compare' function through the type constructor. -compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering -compare2 = liftCompare2 compare compare - --- | Lifting of the 'Read' class to binary type constructors. -class Read2 f where - -- | 'readsPrec' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument types. - liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> - (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b) - - -- | 'readList' function for an application of the type constructor - -- based on 'readsPrec' and 'readList' functions for the argument types. - -- The default implementation using standard list syntax is correct - -- for most types. - liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> - (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b] - liftReadList2 rp1 rl1 rp2 rl2 = - readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Read2 -#endif - --- | Lift the standard 'readsPrec' function through the type constructor. -readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b) -readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList - --- | Lifting of the 'Show' class to binary type constructors. -class Show2 f where - -- | 'showsPrec' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument types. - liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS - - -- | 'showList' function for an application of the type constructor - -- based on 'showsPrec' and 'showList' functions for the argument types. - -- The default implementation using standard list syntax is correct - -- for most types. - liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> - (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS - liftShowList2 sp1 sl1 sp2 sl2 = - showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0) - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Show2 -#endif - --- | Lift the standard 'showsPrec' function through the type constructor. -showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS -showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList - --- Instances for Prelude type constructors - -instance Eq1 Maybe where - liftEq _ Nothing Nothing = True - liftEq _ Nothing (Just _) = False - liftEq _ (Just _) Nothing = False - liftEq eq (Just x) (Just y) = eq x y - -instance Ord1 Maybe where - liftCompare _ Nothing Nothing = EQ - liftCompare _ Nothing (Just _) = LT - liftCompare _ (Just _) Nothing = GT - liftCompare comp (Just x) (Just y) = comp x y - -instance Read1 Maybe where - liftReadsPrec rp _ d = - readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r]) - `mappend` - readsData (readsUnaryWith rp "Just" Just) d - -instance Show1 Maybe where - liftShowsPrec _ _ _ Nothing = showString "Nothing" - liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x - -instance Eq1 [] where - liftEq _ [] [] = True - liftEq _ [] (_:_) = False - liftEq _ (_:_) [] = False - liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys - -instance Ord1 [] where - liftCompare _ [] [] = EQ - liftCompare _ [] (_:_) = LT - liftCompare _ (_:_) [] = GT - liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys - -instance Read1 [] where - liftReadsPrec _ rl _ = rl - -instance Show1 [] where - liftShowsPrec _ sl _ = sl - -instance Eq2 (,) where - liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2 - -instance Ord2 (,) where - liftCompare2 comp1 comp2 (x1, y1) (x2, y2) = - comp1 x1 x2 `mappend` comp2 y1 y2 - -instance Read2 (,) where - liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r -> - [((x,y), w) | ("(",s) <- lex r, - (x,t) <- rp1 0 s, - (",",u) <- lex t, - (y,v) <- rp2 0 u, - (")",w) <- lex v] - -instance Show2 (,) where - liftShowsPrec2 sp1 _ sp2 _ _ (x, y) = - showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' - -instance (Eq a) => Eq1 ((,) a) where - liftEq = liftEq2 (==) - -instance (Ord a) => Ord1 ((,) a) where - liftCompare = liftCompare2 compare - -instance (Read a) => Read1 ((,) a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList - -instance (Show a) => Show1 ((,) a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - -instance Eq2 Either where - liftEq2 e1 _ (Left x) (Left y) = e1 x y - liftEq2 _ _ (Left _) (Right _) = False - liftEq2 _ _ (Right _) (Left _) = False - liftEq2 _ e2 (Right x) (Right y) = e2 x y - -instance Ord2 Either where - liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y - liftCompare2 _ _ (Left _) (Right _) = LT - liftCompare2 _ _ (Right _) (Left _) = GT - liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y - -instance Read2 Either where - liftReadsPrec2 rp1 _ rp2 _ = readsData $ - readsUnaryWith rp1 "Left" Left `mappend` - readsUnaryWith rp2 "Right" Right - -instance Show2 Either where - liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x - liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x - -instance (Eq a) => Eq1 (Either a) where - liftEq = liftEq2 (==) - -instance (Ord a) => Ord1 (Either a) where - liftCompare = liftCompare2 compare - -instance (Read a) => Read1 (Either a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList - -instance (Show a) => Show1 (Either a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - -#if MIN_VERSION_base(4,7,0) -instance Eq1 Proxy where - liftEq _ _ _ = True - -instance Ord1 Proxy where - liftCompare _ _ _ = EQ - -instance Show1 Proxy where - liftShowsPrec _ _ _ _ = showString "Proxy" - -instance Read1 Proxy where - liftReadsPrec _ _ d = - readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) -#endif - --- Instances for other functors defined in the base package - -instance Eq1 Identity where - liftEq eq (Identity x) (Identity y) = eq x y - -instance Ord1 Identity where - liftCompare comp (Identity x) (Identity y) = comp x y - -instance Read1 Identity where - liftReadsPrec rp _ = readsData $ - readsUnaryWith rp "Identity" Identity - -instance Show1 Identity where - liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x - -instance Eq2 Const where - liftEq2 eq _ (Const x) (Const y) = eq x y - -instance Ord2 Const where - liftCompare2 comp _ (Const x) (Const y) = comp x y - -instance Read2 Const where - liftReadsPrec2 rp _ _ _ = readsData $ - readsUnaryWith rp "Const" Const - -instance Show2 Const where - liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x - -instance (Eq a) => Eq1 (Const a) where - liftEq = liftEq2 (==) -instance (Ord a) => Ord1 (Const a) where - liftCompare = liftCompare2 compare -instance (Read a) => Read1 (Const a) where - liftReadsPrec = liftReadsPrec2 readsPrec readList -instance (Show a) => Show1 (Const a) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - --- Building blocks - --- | @'readsData' p d@ is a parser for datatypes where each alternative --- begins with a data constructor. It parses the constructor and --- passes it to @p@. Parsers for various constructors can be constructed --- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with --- @mappend@ from the @Monoid@ class. -readsData :: (String -> ReadS a) -> Int -> ReadS a -readsData reader d = - readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s] - --- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor --- and then parses its argument using @rp@. -readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t -readsUnaryWith rp name cons kw s = - [(cons x,t) | kw == name, (x,t) <- rp 11 s] - --- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary --- data constructor and then parses its arguments using @rp1@ and @rp2@ --- respectively. -readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) -> - String -> (a -> b -> t) -> String -> ReadS t -readsBinaryWith rp1 rp2 name cons kw s = - [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t] - --- | @'showsUnaryWith' sp n d x@ produces the string representation of a --- unary data constructor with name @n@ and argument @x@, in precedence --- context @d@. -showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS -showsUnaryWith sp name d x = showParen (d > 10) $ - showString name . showChar ' ' . sp 11 x - --- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string --- representation of a binary data constructor with name @n@ and arguments --- @x@ and @y@, in precedence context @d@. -showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> - String -> Int -> a -> b -> ShowS -showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $ - showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y - --- Obsolete building blocks - --- | @'readsUnary' n c n'@ matches the name of a unary data constructor --- and then parses its argument using 'readsPrec'. -{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-} -readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t -readsUnary name cons kw s = - [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s] - --- | @'readsUnary1' n c n'@ matches the name of a unary data constructor --- and then parses its argument using 'readsPrec1'. -{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-} -readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t -readsUnary1 name cons kw s = - [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s] - --- | @'readsBinary1' n c n'@ matches the name of a binary data constructor --- and then parses its arguments using 'readsPrec1'. -{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-} -readsBinary1 :: (Read1 f, Read1 g, Read a) => - String -> (f a -> g a -> t) -> String -> ReadS t -readsBinary1 name cons kw s = - [(cons x y,u) | kw == name, - (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t] - --- | @'showsUnary' n d x@ produces the string representation of a unary data --- constructor with name @n@ and argument @x@, in precedence context @d@. -{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-} -showsUnary :: (Show a) => String -> Int -> a -> ShowS -showsUnary name d x = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec 11 x - --- | @'showsUnary1' n d x@ produces the string representation of a unary data --- constructor with name @n@ and argument @x@, in precedence context @d@. -{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-} -showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS -showsUnary1 name d x = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec1 11 x - --- | @'showsBinary1' n d x y@ produces the string representation of a binary --- data constructor with name @n@ and arguments @x@ and @y@, in precedence --- context @d@. -{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-} -showsBinary1 :: (Show1 f, Show1 g, Show a) => - String -> Int -> f a -> g a -> ShowS -showsBinary1 name d x y = showParen (d > 10) $ - showString name . showChar ' ' . showsPrec1 11 x . - showChar ' ' . showsPrec1 11 y - -{- $example -These functions can be used to assemble 'Read' and 'Show' instances for -new algebraic types. For example, given the definition - -> data T f a = Zero a | One (f a) | Two a (f a) - -a standard 'Read1' instance may be defined as - -> instance (Read1 f) => Read1 (T f) where -> liftReadsPrec rp rl = readsData $ -> readsUnaryWith rp "Zero" Zero `mappend` -> readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend` -> readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two - -and the corresponding 'Show1' instance as - -> instance (Show1 f) => Show1 (T f) where -> liftShowsPrec sp _ d (Zero x) = -> showsUnaryWith sp "Zero" d x -> liftShowsPrec sp sl d (One x) = -> showsUnaryWith (liftShowsPrec sp sl) "One" d x -> liftShowsPrec sp sl d (Two x y) = -> showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y - --} 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 deleted file mode 100644 index ed781309af..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Compose.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# 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 diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs deleted file mode 100644 index ba0dc0407e..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Product.hs +++ /dev/null @@ -1,156 +0,0 @@ -{-# 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.Product --- Copyright : (c) Ross Paterson 2010 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : R.Paterson@city.ac.uk --- Stability : experimental --- Portability : portable --- --- Products, lifted to functors. ------------------------------------------------------------------------------ - -module Data.Functor.Product ( - Product(..), - ) where - -import Control.Applicative -import Control.Monad (MonadPlus(..)) -import Control.Monad.Fix (MonadFix(..)) -#if MIN_VERSION_base(4,4,0) -import Control.Monad.Zip (MonadZip(mzipWith)) -#endif -#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 product of functors. -data Product f g a = Pair (f a) (g a) - -#if __GLASGOW_HASKELL__ >= 702 -deriving instance Generic (Product f g a) - -instance Generic1 (Product f g) where - type Rep1 (Product f g) = - D1 MDProduct - (C1 MCPair - (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g))) - from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g))) - to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g) - -data MDProduct -data MCPair - -instance Datatype MDProduct where - datatypeName _ = "Product" - moduleName _ = "Data.Functor.Product" - -instance Constructor MCPair where - conName _ = "Pair" -#endif - -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Product -deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a) - => Data (Product (f :: * -> *) (g :: * -> *) (a :: *)) -#endif - -instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where - liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 - -instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where - liftCompare comp (Pair x1 y1) (Pair x2 y2) = - liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2 - -instance (Read1 f, Read1 g) => Read1 (Product f g) where - liftReadsPrec rp rl = readsData $ - readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair - -instance (Show1 f, Show1 g) => Show1 (Product f g) where - liftShowsPrec sp sl d (Pair x y) = - showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y - -instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) - where (==) = eq1 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 -instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where - readsPrec = readsPrec1 -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showsPrec = showsPrec1 - -instance (Functor f, Functor g) => Functor (Product f g) where - fmap f (Pair x y) = Pair (fmap f x) (fmap f y) - -instance (Foldable f, Foldable g) => Foldable (Product f g) where - foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y - -instance (Traversable f, Traversable g) => Traversable (Product f g) where - traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y - -instance (Applicative f, Applicative g) => Applicative (Product f g) where - pure x = Pair (pure x) (pure x) - Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y) - -instance (Alternative f, Alternative g) => Alternative (Product f g) where - empty = Pair empty empty - Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2) - -instance (Monad f, Monad g) => Monad (Product f g) where -#if !(MIN_VERSION_base(4,8,0)) - return x = Pair (return x) (return x) -#endif - Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f) - where - fstP (Pair a _) = a - sndP (Pair _ b) = b - -instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where - mzero = Pair mzero mzero - Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2) - -instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where - mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f)) - where - fstP (Pair a _) = a - sndP (Pair _ b) = b - -#if MIN_VERSION_base(4,4,0) -instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where - mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2) -#endif - -#if MIN_VERSION_base(4,12,0) -instance (Contravariant f, Contravariant g) => Contravariant (Product f g) where - contramap f (Pair a b) = Pair (contramap f a) (contramap f b) -#endif 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 deleted file mode 100644 index e6d1428b30..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre711/Data/Functor/Sum.hs +++ /dev/null @@ -1,136 +0,0 @@ -{-# 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 |