b7403d0 · elk · git.iko.soy

src/AST/Type.hs+1−1

compare with master

unifiedsplit

@@ -30,7 +30,7 @@ data Raw'

30 | RVar String

31 | RType Var.Raw

32 | RApp Raw [Raw]

33− | RRecord [(String, Raw)] (Maybe Raw)

33+ | RRecord [(A.Located String, Raw)] (Maybe Raw)

34

35

36data Canonical

src/Canonicalize/Type.hs+2−2

@@ -21,7 +21,7 @@ tipe env annType@(A.A _ typ) =

21 go =

22 tipe env

23

24− goSnd (name,t) =

24+ goField (A.A _ name, t) =

25 (,) name <$> go t

26 in

27 case typ of

@@ -38,7 +38,7 @@ tipe env annType@(A.A _ typ) =

38 T.Lambda <$> go a <*> go b

39

40 T.RRecord fields ext ->

41− T.Record <$> Trav.traverse goSnd fields <*> Trav.traverse go ext

41+ T.Record <$> Trav.traverse goField fields <*> Trav.traverse go ext

42

43

44canonicalizeApp :: Env.Env -> T.Raw -> [T.Raw] -> Result T.Canonical

src/Elm/Compiler/Type.hs+2−2

@@ -5,7 +5,7 @@ module Elm.Compiler.Type

5 )

6 where

7

8−import Control.Arrow (second)

8+import Control.Arrow ((***))

9import Data.Aeson ((.:), (.=))

10import qualified Data.Aeson as Json

11import qualified Data.Aeson.Types as Json

@@ -212,7 +212,7 @@ fromRawType (A.A _ astType) =

212 App (fromRawType t) (map fromRawType ts)

213

214 Type.RRecord fields ext ->

215− Record (map (second fromRawType) fields) (fmap fromRawType ext)

215+ Record (map (A.drop *** fromRawType) fields) (fmap fromRawType ext)

216

217

218

src/Parse/Type.hs+1−1

@@ -45,7 +45,7 @@ record =

45 return (Type.RRecord fields (Just (A.map Type.RVar ext)))

46

47 field =

48− do lbl <- rLabel

48+ do lbl <- addLocation rLabel

49 whitespace >> hasType >> whitespace

50 (,) lbl <$> expr

51

src/Reporting/Error/Canonicalize.hs+2−2

@@ -1,7 +1,7 @@

1{-# OPTIONS_GHC -Wall #-}

2module Reporting.Error.Canonicalize where

3

4−import Control.Arrow (second)

4+import Control.Arrow ((***))

5import qualified Data.Char as Char

6import Text.PrettyPrint.ANSI.Leijen (Doc, dullyellow, fillSep, indent, text)

7

@@ -355,7 +355,7 @@ unsafePromote (A.A _ rawType) =

355 Type.App (unsafePromote func) (map unsafePromote args)

356

357 Type.RRecord fields ext ->

358− Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)

358+ Type.Record (map (A.drop *** unsafePromote) fields) (fmap unsafePromote ext)

359

360

361

src/Validate.hs+28−25

@@ -622,32 +622,34 @@ detectDuplicates tag names =

622

623checkTypeVarsInUnion :: A.Commented (D.Union Type.Raw) -> Result wrn ()

624checkTypeVarsInUnion (A.A (region,_) (D.Type name boundVars ctors)) =

625+ do allFreeVars <- concat <$> traverse freeVars (concatMap snd ctors)

625− case diff boundVars (concatMap freeVars (concatMap snd ctors)) of

626+ case diff boundVars allFreeVars of

626− (_, []) ->

627+ (_, []) ->

627− return ()

628+ return ()

628

629

629− (_, unbound) ->

630+ (_, unbound) ->

630− Result.throw region

631+ Result.throw region

631− (Error.UnboundTypeVarsInUnion name boundVars unbound)

632+ (Error.UnboundTypeVarsInUnion name boundVars unbound)

632

633

634

634checkTypeVarsInAlias :: A.Commented (D.Alias Type.Raw) -> Result wrn ()

635checkTypeVarsInAlias :: A.Commented (D.Alias Type.Raw) -> Result wrn ()

635checkTypeVarsInAlias (A.A (region,_) (D.Type name boundVars tipe)) =

636checkTypeVarsInAlias (A.A (region,_) (D.Type name boundVars tipe)) =

637+ do allFreeVars <- freeVars tipe

636− case diff boundVars (freeVars tipe) of

638+ case diff boundVars allFreeVars of

637− ([], []) ->

639+ ([], []) ->

638− return ()

640+ return ()

639

641

640− ([], unbound) ->

642+ ([], unbound) ->

641− Result.throw region

643+ Result.throw region

642− (Error.UnboundTypeVarsInAlias name boundVars unbound)

644+ (Error.UnboundTypeVarsInAlias name boundVars unbound)

643

645

644− (unused, []) ->

646+ (unused, []) ->

645− Result.throw region

647+ Result.throw region

646− (Error.UnusedTypeVarsInAlias name boundVars unused)

648+ (Error.UnusedTypeVarsInAlias name boundVars unused)

647

649

648− (unused, unbound) ->

650+ (unused, unbound) ->

649− Result.throw region

651+ Result.throw region

650− (Error.MessyTypeVarsInAlias name boundVars unused unbound)

652+ (Error.MessyTypeVarsInAlias name boundVars unused unbound)

651

653

652

654

653diff :: [String] -> [A.Located String] -> ([String], [String])

655diff :: [String] -> [A.Located String] -> ([String], [String])

@@ -664,21 +666,22 @@ diff left right =

664 )

666 )

665

667

666

668

667−freeVars :: Type.Raw -> [A.Located String]

669+freeVars :: Type.Raw -> Result wrn [A.Located String]

668freeVars (A.A region tipe) =

670freeVars (A.A region tipe) =

669 case tipe of

671 case tipe of

670 Type.RLambda t1 t2 ->

672 Type.RLambda t1 t2 ->

671− freeVars t1 ++ freeVars t2

673+ (++) <$> freeVars t1 <*> freeVars t2

672

674

673 Type.RVar x ->

675 Type.RVar x ->

674− [A.A region x]

676+ Result.ok [A.A region x]

675

677

676 Type.RType _ ->

678 Type.RType _ ->

677− []

679+ Result.ok []

678

680

679 Type.RApp t ts ->

681 Type.RApp t ts ->

680− concatMap freeVars (t:ts)

682+ concat <$> traverse freeVars (t:ts)

681

683

682 Type.RRecord fields ext ->

684 Type.RRecord fields ext ->

683− maybe [] freeVars ext

685+ do checkDuplicateFields region fields

684− ++ concatMap (freeVars . snd) fields

686+ let types = Maybe.maybeToList ext ++ map snd fields

687+ concat <$> traverse freeVars types