322292c · rowtype-yoga/purescript-native

psc/Main.hs+4−5

compare with golang

unifiedsplit

@@ -71,15 +71,14 @@ compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = d

71 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

72 let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms

73 makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix

74− e <- runMake opts $ P.make makeActions (map snd ms)

74+ (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)

75+ when (P.nonEmpty warnings') $

76+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')

75 case e of

77 case e of

76 Left errs -> do

78 Left errs -> do

77 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

79 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

78 exitFailure

80 exitFailure

79− Right (_, warnings') -> do

80− when (P.nonEmpty warnings') $

81− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')

82− exitSuccess

81+ Right _ -> exitSuccess

83

82

84warnFileTypeNotFound :: String -> IO ()

83warnFileTypeNotFound :: String -> IO ()

85warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)

84warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)

psci/PSCi.hs+1−1

@@ -254,7 +254,7 @@ modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

254-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the

255-- options and ignores the warning messages.

256runMake :: P.Make a -> IO (Either P.MultipleErrors a)

257−runMake mk = fmap (fmap fst) $ P.runMake P.defaultOptions mk

257+runMake mk = fmap fst $ P.runMake P.defaultOptions mk

258

259makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a

260makeIO f io = do

purescript.cabal+1

@@ -170,6 +170,7 @@ library

170 Language.PureScript.Publish.ErrorsWarnings

171 Language.PureScript.Publish.BoxesHelpers

172

173+ Control.Monad.Logger

173 Control.Monad.Unify

174 Control.Monad.Unify

174 Control.Monad.Supply

175 Control.Monad.Supply

175 Control.Monad.Supply.Class

176 Control.Monad.Supply.Class

src/Control/Monad/Logger.hsnew file+75

@@ -0,0 +1,75 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Control.Monad.Logger

4+-- Author : Phil Freeman

5+-- License : MIT (http://opensource.org/licenses/MIT)

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- | A replacement for WriterT IO which uses mutable references.

12+--

13+-----------------------------------------------------------------------------

14+

15+{-# LANGUAGE CPP #-}

16+{-# LANGUAGE FlexibleInstances #-}

17+{-# LANGUAGE MultiParamTypeClasses #-}

18+{-# LANGUAGE TypeFamilies #-}

19+

20+module Control.Monad.Logger where

21+

22+import Data.IORef

23+

24+#if __GLASGOW_HASKELL__ < 710

25+import Control.Applicative

26+#endif

27+import Control.Monad (ap)

28+import Control.Monad.IO.Class

29+import Control.Monad.Writer.Class

30+import Control.Monad.Base (MonadBase(..))

31+import Control.Monad.Trans.Control (MonadBaseControl(..))

32+

33+-- | A replacement for WriterT IO which uses mutable references.

34+data Logger w a = Logger { runLogger :: IORef w -> IO a }

35+

36+-- | Run a Logger computation, starting with an empty log.

37+runLogger' :: (Monoid w) => Logger w a -> IO (a, w)

38+runLogger' l = do

39+ r <- newIORef mempty

40+ a <- runLogger l r

41+ w <- readIORef r

42+ return (a, w)

43+

44+instance Functor (Logger w) where

45+ fmap f (Logger l) = Logger $ \r -> fmap f (l r)

46+

47+instance (Monoid w) => Applicative (Logger w) where

48+ pure = Logger . const . pure

49+ (<*>) = ap

50+

51+instance (Monoid w) => Monad (Logger w) where

52+ return = pure

53+ Logger l >>= f = Logger $ \r -> l r >>= \a -> runLogger (f a) r

54+

55+instance (Monoid w) => MonadIO (Logger w) where

56+ liftIO = Logger . const

57+

58+instance (Monoid w) => MonadWriter w (Logger w) where

59+ tell w = Logger $ \r -> modifyIORef' r (mappend w)

60+ listen l = Logger $ \r -> do

61+ (a, w) <- liftIO (runLogger' l)

62+ modifyIORef' r (mappend w)

63+ return (a, w)

64+ pass l = Logger $ \r -> do

65+ ((a, f), w) <- liftIO (runLogger' l)

66+ modifyIORef' r (mappend (f w))

67+ return a

68+

69+instance (Monoid w) => MonadBase IO (Logger w) where

70+ liftBase = liftIO

71+

72+instance (Monoid w) => MonadBaseControl IO (Logger w) where

73+ type StM (Logger w) a = a

74+ liftBaseWith f = Logger $ \r -> liftBaseWith $ \q -> f (q . flip runLogger r)

75+ restoreM = return

src/Language/PureScript/Make.hs+6−5

@@ -43,9 +43,10 @@ import Control.Applicative

43#endif

44import Control.Monad

45import Control.Monad.Error.Class (MonadError(..))

46+import Control.Monad.Writer.Class (MonadWriter(..))

46import Control.Monad.Trans.Except

47import Control.Monad.Trans.Except

47import Control.Monad.Reader

48import Control.Monad.Reader

48−import Control.Monad.Writer.Strict

49+import Control.Monad.Logger

49import Control.Monad.Supply

50import Control.Monad.Supply

50import Control.Monad.Base (MonadBase(..))

51import Control.Monad.Base (MonadBase(..))

51import Control.Monad.Trans.Control (MonadBaseControl(..))

52import Control.Monad.Trans.Control (MonadBaseControl(..))

@@ -284,22 +285,22 @@ importPrim = addDefaultImport (ModuleName [ProperName C.prim])

284-- |

285-- |

285-- A monad for running make actions

286-- A monad for running make actions

286--

287--

287−newtype Make a = Make { unMake :: ReaderT Options (WriterT MultipleErrors (ExceptT MultipleErrors IO)) a }

288+newtype Make a = Make { unMake :: ReaderT Options (ExceptT MultipleErrors (Logger MultipleErrors)) a }

288 deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)

289 deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)

289

290

290instance MonadBase IO Make where

291instance MonadBase IO Make where

291 liftBase = liftIO

292 liftBase = liftIO

292

293

293instance MonadBaseControl IO Make where

294instance MonadBaseControl IO Make where

294− type StM Make a = Either MultipleErrors (a, MultipleErrors)

295+ type StM Make a = Either MultipleErrors a

295 liftBaseWith f = Make $ liftBaseWith $ \q -> f (q . unMake)

296 liftBaseWith f = Make $ liftBaseWith $ \q -> f (q . unMake)

296 restoreM = Make . restoreM

297 restoreM = Make . restoreM

297

298

298-- |

299-- |

299-- Execute a 'Make' monad, returning either errors, or the result of the compile plus any warnings.

300-- Execute a 'Make' monad, returning either errors, or the result of the compile plus any warnings.

300--

301--

301−runMake :: Options -> Make a -> IO (Either MultipleErrors (a, MultipleErrors))

302+runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)

302−runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake

303+runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake

303

304

304makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a

305makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a

305makeIO f io = do

306makeIO f io = do

tests/Main.hs+1−1

@@ -104,7 +104,7 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do

104type TestM = WriterT [(FilePath, String)] IO

105

106runTest :: P.Make a -> IO (Either P.MultipleErrors a)

107−runTest = fmap (fmap fst) . P.runMake P.defaultOptions

107+runTest = fmap fst . P.runMake P.defaultOptions

108

109compile :: [FilePath] -> M.Map P.ModuleName FilePath -> IO (Either P.MultipleErrors P.Environment)

110compile inputFiles foreigns = runTest $ do