3fbe01d · rowtype-yoga/purescript-native

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

compare with golang

unifiedsplit

@@ -297,11 +297,6 @@ makeIO f io = do

297readTextFile :: FilePath -> Make String

298readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path

299

300−-- Traverse (Either e) instance (base 4.7)

301−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)

302−traverseEither _ (Left x) = pure (Left x)

303−traverseEither f (Right y) = Right <$> f y

304−

305-- |

300-- |

306-- A set of make actions that read and write modules from the given directory.

301-- A set of make actions that read and write modules from the given directory.

307--

302--

@@ -317,7 +312,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

317 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))

312 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))

318 getInputTimestamp mn = do

313 getInputTimestamp mn = do

319 let path = fromMaybe (internalError "Module has no filename in 'make'") $ M.lookup mn filePathMap

314 let path = fromMaybe (internalError "Module has no filename in 'make'") $ M.lookup mn filePathMap

320− e1 <- traverseEither getTimestamp path

315+ e1 <- traverse getTimestamp path

321 fPath <- maybe (return Nothing) getTimestamp $ M.lookup mn foreigns

316 fPath <- maybe (return Nothing) getTimestamp $ M.lookup mn foreigns

322 return $ fmap (max fPath) e1

317 return $ fmap (max fPath) e1

323

318

src/Language/PureScript/Sugar.hs+1−1

@@ -34,7 +34,7 @@ import Language.PureScript.Sugar.TypeDeclarations as S

34--

35-- * Desugar operator sections

36--

37−-- * Desugar do-notation using the @Prelude.Monad@ type class

37+-- * Desugar do-notation

38--

39-- * Desugar top-level case declarations into explicit case expressions

40--

src/Language/PureScript/Sugar/CaseDeclarations.hs+1−5

@@ -9,6 +9,7 @@ module Language.PureScript.Sugar.CaseDeclarations

9

10import Prelude.Compat

11

12+import Data.Either (isLeft)

12import Data.List (nub, groupBy, foldl1')

13import Data.List (nub, groupBy, foldl1')

13import Data.Maybe (catMaybes, mapMaybe)

14import Data.Maybe (catMaybes, mapMaybe)

14

15

@@ -24,11 +25,6 @@ import Language.PureScript.Names

24import Language.PureScript.Traversals

25import Language.PureScript.Traversals

25import Language.PureScript.TypeChecker.Monad (guardWith)

26import Language.PureScript.TypeChecker.Monad (guardWith)

26

27

27−-- Data.Either.isLeft (base 4.7)

28−isLeft :: Either a b -> Bool

29−isLeft (Left _) = True

30−isLeft (Right _) = False

31−

32-- |

28-- |

33-- Replace all top-level binders in a module with case expressions.

29-- Replace all top-level binders in a module with case expressions.

34--

30--

src/Language/PureScript/Sugar/DoNotation.hs+7−3

@@ -1,6 +1,6 @@

1-- |

2-- This module implements the desugaring pass which replaces do-notation statements with

3−-- appropriate calls to bind from the Prelude.Monad type class.

3+-- appropriate calls to bind.

4--

5module Language.PureScript.Sugar.DoNotation (desugarDoModule) where

6

@@ -17,12 +17,16 @@ import Language.PureScript.Names

17import qualified Language.PureScript.Constants as C

18

19-- |

20−-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.bind function,

20+-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with

21+-- applications of the bind function in scope, and all @DoNotationLet@

21−-- and all @DoNotationLet@ constructors with let expressions.

22+-- constructors with let expressions.

22--

23--

23desugarDoModule :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Module -> m Module

24desugarDoModule :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Module -> m Module

24desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts

25desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts

25

26

27+-- |

28+-- Desugar a single do statement

29+--

26desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

30desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

27desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)

31desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)

28desugarDo d =

32desugarDo d =