Fix building on ghc-7.6 (base 4.6) for purescript#713

dylex · dylex · commit 7c90e56ee771 · 2014-11-18T14:49:14.000-05:00
Just add missing functions or rewrite in simple cases.
Also add explicit base version requirement.
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
@@ -19,7 +19,6 @@ module Main where
 import Control.Applicative
 import Control.Monad.Error
 
-import Data.Bool (bool)
 import Data.Version (showVersion)
 
 import System.Console.CmdTheLine
@@ -41,7 +40,7 @@ data InputOptions = InputOptions
 readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
 readInput InputOptions{..} = do
   content <- forM ioInputFiles $ \inputFile -> (Right inputFile, ) <$> U.readFile inputFile
-  return $ bool ((Left P.RebuildNever, P.prelude) :) id ioNoPrelude content
+  return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)
 
 newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)
 
diff --git a/psc/Main.hs b/psc/Main.hs
@@ -19,7 +19,6 @@ module Main where
 import Control.Applicative
 import Control.Monad.Error
 
-import Data.Bool (bool)
 import Data.Maybe (fromMaybe)
 import Data.Version (showVersion)
 
@@ -43,7 +42,7 @@ readInput :: InputOptions -> IO [(Maybe FilePath, String)]
 readInput InputOptions{..}
   | ioUseStdIn = return . (Nothing ,) <$> getContents
   | otherwise = do content <- forM ioInputFiles $ \inputFile -> (Just inputFile, ) <$> U.readFile inputFile
-                   return $ bool ((Nothing, P.prelude) :) id ioNoPrelude content
+                   return (if ioNoPrelude then content else (Nothing, P.prelude) : content)
 
 compile :: P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()
 compile opts stdin input output externs usePrefix = do
diff --git a/purescript.cabal b/purescript.cabal
@@ -24,7 +24,7 @@ source-repository head
     location: https://github.com/purescript/purescript.git
 
 library
-    build-depends: base >=4 && <5,
+    build-depends: base >=4.6 && <5,
                    cmdtheline == 0.2.*,
                    containers -any,
                    unordered-containers -any,
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
@@ -42,7 +42,6 @@ import Data.Time.Clock
 import Data.Function (on)
 import Data.Maybe (fromMaybe)
 import Data.FileEmbed (embedFile)
-import Data.Traversable (traverse)
 
 import Control.Monad.Error
 import Control.Arrow ((&&&))
@@ -142,6 +141,11 @@ data RebuildPolicy
   -- | Always rebuild this module
   | RebuildAlways deriving (Show, Eq, Ord)
 
+-- Traverse (Either e) instance (base 4.7)
+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
+traverseEither _ (Left x) = pure (Left x)
+traverseEither f (Right y) = Right <$> f y
+
 -- |
 -- Compiles in "make" mode, compiling each module separately to a js files and an externs file
 --
@@ -163,7 +167,7 @@ make outputDir opts ms prefix = do
 
     jsTimestamp <- getTimestamp jsFile
     externsTimestamp <- getTimestamp externsFile
-    inputTimestamp <- traverse getTimestamp inputFile
+    inputTimestamp <- traverseEither getTimestamp inputFile
 
     return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
       (Right (Just t1), Just t2, Just t3) | t1 < min t2 t3 -> s
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -19,7 +19,6 @@ module Language.PureScript.Sugar.CaseDeclarations (
     desugarCasesModule
 ) where
 
-import Data.Either (isLeft)
 import Data.Monoid ((<>))
 import Data.List (nub, groupBy)
 
@@ -35,6 +34,11 @@ import Language.PureScript.Supply
 import Language.PureScript.Traversals
 import Language.PureScript.TypeChecker.Monad (guardWith)
 
+-- Data.Either.isLeft (base 4.7)
+isLeft :: Either a b -> Bool
+isLeft (Left _) = True
+isLeft (Right _) = False
+
 -- |
 -- Replace all top-level binders in a module with case expressions.
 --
