backport bifunctor

protolude.cabal

@@ -43,6 +43,7 @@ library
     Show
     Unsafe
     Functor
+    Bifunctor
 
   default-extensions:
     NoImplicitPrelude

src/Applicative.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module Applicative (
   orAlt,
   orEmpty,

src/Bifunctor.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Bifunctor (
+  Bifunctor(..)
+) where
+
+import Data.Function (id, (.))
+import Data.Either (Either(..))
+import Control.Applicative ( Const(..) )
+
+class Bifunctor p where
+    {-# MINIMAL bimap | first, second #-}
+
+    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
+    bimap f g = first f . second g
+
+    first :: (a -> b) -> p a c -> p b c
+    first f = bimap f id
+
+    second :: (b -> c) -> p a b -> p a c
+    second = bimap id
+
+instance Bifunctor (,) where
+    bimap f g ~(a, b) = (f a, g b)
+
+instance Bifunctor ((,,) x1) where
+    bimap f g ~(x1, a, b) = (x1, f a, g b)
+
+instance Bifunctor ((,,,) x1 x2) where
+    bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)
+
+instance Bifunctor ((,,,,) x1 x2 x3) where
+    bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)
+
+instance Bifunctor ((,,,,,) x1 x2 x3 x4) where
+    bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)
+
+instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where
+    bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)
+
+instance Bifunctor Either where
+    bimap f _ (Left a) = Left (f a)
+    bimap _ g (Right b) = Right (g b)
+
+instance Bifunctor Const where
+    bimap f _ (Const a) = Const (f a)

src/Bool.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module Bool (
     whenM
   , unlessM
@@ -6,8 +9,9 @@ module Bool (
   , bool
   ) where
 
-import Prelude
-import Control.Monad (MonadPlus, when, unless, guard)
+import Data.Bool (Bool)
+import Data.Function (flip)
+import Control.Monad (Monad, MonadPlus, when, unless, guard, (>>=), (=<<))
 
 bool :: a -> a -> Bool -> a
 bool f t p = if p then t else f

src/Debug.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE Unsafe #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Debug (

src/Either.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module Either (
   maybeToLeft
 , maybeToRight
@@ -6,6 +9,11 @@ module Either (
 , maybeToEither
 ) where
 
+import Data.Function (const)
+import Data.Monoid (Monoid, mempty)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Either (Either(..), either)
+
 leftToMaybe :: Either l r -> Maybe l
 leftToMaybe = either Just (const Nothing)
 
@@ -18,5 +26,5 @@ maybeToRight l = maybe (Left l) Right
 maybeToLeft :: r -> Maybe l -> Either l r
 maybeToLeft r = maybe (Right r) Left
 
-maybeToEither :: Monoid b => Maybe a -> Either b a
+maybeToEither :: Monoid b => (a -> b) -> Maybe a -> b
 maybeToEither = maybe mempty

src/List.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module List (
   head,
   ordNub,

src/Monad.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Monad (
@@ -38,7 +39,8 @@ module Monad (
   , (<$!>)
   ) where
 
-import Prelude (concat, seq)
+import Data.List (concat)
+import Prelude (seq)
 
 #if (__GLASGOW_HASKELL__ >= 710)
 import Control.Monad hiding ((<$!>))

src/Protolude.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 
@@ -23,6 +24,7 @@ import qualified Bool as X
 import qualified Debug as X
 import qualified Monad as X
 import qualified Functor as X
+import qualified Either as X
 import qualified Applicative as X
 
 -- Maybe'ized version of partial functions
@@ -57,6 +59,12 @@ import Data.Foldable as X hiding (
 import Data.Semiring as X
 import Data.Functor.Identity as X
 
+#if (__GLASGOW_HASKELL__ >= 710)
+import Data.Bifunctor as X (Bifunctor(..))
+#else
+import Bifunctor as X (Bifunctor(..))
+#endif
+
 -- Deepseq
 import Control.DeepSeq as X (
     NFData(..)
@@ -67,6 +75,7 @@ import Control.DeepSeq as X (
 
 -- Data structures
 import Data.Tuple as X
+import Data.Semiring as X
 import Data.List as X (
     splitAt
   , break

src/Show.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Show (