54df18a · elk · git.iko.soy

src/Compile.hs−9

compare with master

unifiedsplit

@@ -9,10 +9,8 @@ import qualified Parse.Parse as Parse

9import qualified Reporting.Error as Error

10import qualified Reporting.Result as Result

11import qualified Reporting.Warning as Warning

12−import qualified Reporting.Annotation as A

13import qualified Type.Inference as TI

12import qualified Type.Inference as TI

14import qualified Canonicalize

13import qualified Canonicalize

15−import qualified CheckMatch

16

14

17

15

18compile

16compile

@@ -46,13 +44,6 @@ compile user projectName interfaces source =

46 -- Add the real list of tyes

44 -- Add the real list of tyes

47 let body = (Module.body canonicalModule) { Module.types = types }

45 let body = (Module.body canonicalModule) { Module.types = types }

48

46

49− case CheckMatch.checkBody interfaces body of

50− Left (A.A r matchError) ->

51− Result.throw r (Error.CheckMatch matchError)

52−

53− Right matchWarnings ->

54− Result.addWarnings (map (A.map Warning.MatchWarning) matchWarnings) (return ())

55−

56 return $ canonicalModule { Module.body = body }

47 return $ canonicalModule { Module.body = body }

57

48

58

49

src/CheckMatch.hs → src/Nitpick/PatternMatches.hsrenamed+20−18

@@ -1,30 +1,27 @@

1{-# LANGUAGE NamedFieldPuns, TupleSections #-}

2−module CheckMatch

2+module Nitpick.PatternMatches

3 ( checkBody

4 , Pat (..)

5 , CanonicalPat

6 ) where

7

8import Control.Applicative ((<$>), (<*>))

9−import Control.Monad.Except (throwError)

9+import Control.Monad.Except (forM, liftM, throwError)

10−import Control.Monad (liftM)

11−import Control.Monad (forM)

12−

13import Data.Maybe (mapMaybe, catMaybes)

10import Data.Maybe (mapMaybe, catMaybes)

14import qualified Data.Set as Set

11import qualified Data.Set as Set

15import qualified Data.Map as Map

12import qualified Data.Map as Map

16

13

17−import Elm.Utils ((|>))

18import qualified AST.Expression.General as General

14import qualified AST.Expression.General as General

19import qualified AST.Expression.Canonical as Canonical

15import qualified AST.Expression.Canonical as Canonical

20import qualified AST.Module as Module

16import qualified AST.Module as Module

21import qualified AST.Pattern as Pattern

17import qualified AST.Pattern as Pattern

22−import AST.Pattern (CanonicalPattern)

18+import qualified AST.Variable as Var

19+import Elm.Utils ((|>))

23import qualified Reporting.Annotation as Annotation

20import qualified Reporting.Annotation as Annotation

21+import qualified Reporting.Error.Nitpick as Error

24import qualified Reporting.Region as Region

22import qualified Reporting.Region as Region

25−import qualified AST.Variable as Var

23+import qualified Reporting.Warning.Nitpick as Warning

26−import qualified Reporting.Error.CheckMatch as Error

24+

27−import Reporting.Warning.CheckMatch

28

25

29type M =

26type M =

30 Either (Annotation.Located Error.Error)

27 Either (Annotation.Located Error.Error)

@@ -80,7 +77,7 @@ checkBody interfaces =

80 General.Let defs e ->

77 General.Let defs e ->

81 concat <$> sequence [ps, rhssResults, checkExpr e]

78 concat <$> sequence [ps, rhssResults, checkExpr e]

82 where

79 where

83− ps = mapMaybeM (\(Canonical.Definition p _ _) -> checkMatch r [p]) defs

80+ ps = filterMapM (\(Canonical.Definition p _ _) -> checkMatch r [p]) defs

84

81

85 rhssResults = concatMapM (\(Canonical.Definition _ e _) -> checkExpr e) defs

82 rhssResults = concatMapM (\(Canonical.Definition _ e _) -> checkExpr e) defs

86

83

@@ -252,17 +249,22 @@ checkBody interfaces =

252

249

253

250

254-- Util

251-- Util

252+

255concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]

253concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]

256−concatMapM f =

254+concatMapM f list =

257− liftM concat . mapM f

255+ liftM concat (mapM f list)

258

256

259

257

260−mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]

258+filterMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]

261−mapMaybeM f =

259+filterMapM f list =

262− liftM catMaybes . mapM f

260+ liftM catMaybes (mapM f list)

263

261

264

262

265maybeCons :: Maybe a -> [a] -> [a]

263maybeCons :: Maybe a -> [a] -> [a]

266−maybeCons =

264+maybeCons maybe list =

267− maybe id (:)

265+ case maybe of

266+ Just x ->

267+ x : list

268

269+ Nothing ->

270+ list

src/Reporting/Error.hs−2

@@ -5,7 +5,6 @@ import qualified Reporting.Annotation as A

5import qualified Reporting.Error.Canonicalize as Canonicalize

6import qualified Reporting.Error.Syntax as Syntax

7import qualified Reporting.Error.Type as Type

8−import qualified Reporting.Error.CheckMatch as CheckMatch

9import qualified Reporting.Report as Report

8import qualified Reporting.Report as Report

10

9

11

10

@@ -15,7 +14,6 @@ data Error

15 = Syntax Syntax.Error

14 = Syntax Syntax.Error

16 | Canonicalize Canonicalize.Error

15 | Canonicalize Canonicalize.Error

17 | Type Type.Error

16 | Type Type.Error

18− | CheckMatch CheckMatch.Error

19

17

20

18

21-- TO STRING

19-- TO STRING

src/Reporting/Error/CheckMatch.hs → src/Reporting/Error/Nitpick.hsrenamed+4−3

@@ -1,10 +1,11 @@

1−module Reporting.Error.CheckMatch where

1+module Reporting.Error.Nitpick where

2

3import qualified Data.Aeson as Json

4

5import qualified AST.Variable as Var

6import qualified Reporting.Region as R

7

8+

8data Error = ConstructorTypeNotFound Var.Canonical

9data Error = ConstructorTypeNotFound Var.Canonical

9

10

10-- TO STRING

11-- TO STRING

@@ -12,7 +13,7 @@ data Error = ConstructorTypeNotFound Var.Canonical

12toString :: R.Region -> Error -> String

13toString :: R.Region -> Error -> String

13toString region err =

14toString region err =

14 case err of

15 case err of

15− _ -> error "CheckMatch.toString" region

16+ _ -> error "Nitpick.toString" region

16

17

18

18-- TO JSON

19-- TO JSON

@@ -20,5 +21,5 @@ toString region err =

20toJson :: Error -> Json.Value

21toJson :: Error -> Json.Value

21toJson err =

22toJson err =

22 case err of

23 case err of

23− _ -> error "CheckMatch.toJson"

24+ _ -> error "Nitpick.toJson"

24

25

src/Reporting/Warning.hs+1−3

@@ -4,13 +4,11 @@ import qualified AST.Module as Module

4

5import qualified Reporting.Annotation as A

6

7−import qualified Reporting.Warning.CheckMatch as CheckMatch

8−

9

7

10data Warning

8data Warning

11 = UnusedImport Module.Name

9 = UnusedImport Module.Name

12 | MissingTypeAnnotation String

10 | MissingTypeAnnotation String

13− | MatchWarning CheckMatch.Warning

11+

14

12

15-- TO STRING

13-- TO STRING

16

14

src/Reporting/Warning/CheckMatch.hs → src/Reporting/Warning/Nitpick.hsrenamed+4−1

@@ -1,10 +1,11 @@

1−module Reporting.Warning.CheckMatch where

1+module Reporting.Warning.Nitpick where

2

3import qualified AST.Pattern as Pattern

4import qualified AST.Literal as Literal

5import qualified Data.Set as Set

6import qualified AST.Variable as Var

7

8+

8data Pat var

9data Pat var

9 = Data var [Pat var]

10 = Data var [Pat var]

10 | Record [String]

11 | Record [String]

@@ -17,9 +18,11 @@ data Pat var

17 | AnythingBut (Set.Set Literal.Literal)

18 | AnythingBut (Set.Set Literal.Literal)

18 deriving (Show, Eq)

19 deriving (Show, Eq)

19

20

21+

20type CanonicalPat =

22type CanonicalPat =

21 Pat Var.Canonical

23 Pat Var.Canonical

22

24

25+

23data Warning

26data Warning

24 = Redundant Pattern.CanonicalPattern

27 = Redundant Pattern.CanonicalPattern

25 -- The argument is the list of patterns that would have to

28 -- The argument is the list of patterns that would have to