3f6492f · elk · git.iko.soy

builder/src/File/Compile.hs+6−40

compare with master

unifiedsplit

@@ -26,8 +26,8 @@ import qualified Reporting.Task as Task

26-- COMPILE

27

28

29−compile :: Project -> Maybe FilePath -> I.Interfaces -> Dict Plan.Info -> Task.Task (Dict Answer)

29+compile :: Project -> I.Interfaces -> Dict Plan.Info -> Task.Task (Dict Answer)

30−compile project maybeDocsPath ifaces modules =

30+compile project ifaces modules =

31 do Task.report (Progress.CompileStart (Map.size modules))

32

33 tell <- Task.getReporter

@@ -35,7 +35,7 @@ compile project maybeDocsPath ifaces modules =

35 answers <- liftIO $

36 do mvar <- newEmptyMVar

37 iMVar <- newMVar ifaces

38− answerMVars <- Map.traverseWithKey (compileModule tell project maybeDocsPath mvar iMVar) modules

38+ answerMVars <- Map.traverseWithKey (compileModule tell project mvar iMVar) modules

39 putMVar mvar answerMVars

40 traverse readMVar answerMVars

41

@@ -64,13 +64,12 @@ type Dict a = Map.Map ModuleName.Raw a

64compileModule

65 :: (Progress.Progress -> IO ())

66 -> Project

67− -> Maybe FilePath

68 -> MVar (Dict (MVar Answer))

67 -> MVar (Dict (MVar Answer))

69 -> MVar I.Interfaces

68 -> MVar I.Interfaces

70 -> ModuleName.Raw

69 -> ModuleName.Raw

71 -> Plan.Info

70 -> Plan.Info

72 -> IO (MVar Answer)

71 -> IO (MVar Answer)

73−compileModule tell project maybeDocsPath answersMVar ifacesMVar name info =

72+compileModule tell project answersMVar ifacesMVar name info =

74 do mvar <- newEmptyMVar

73 do mvar <- newEmptyMVar

75

74

76 void $ forkIO $

75 void $ forkIO $

@@ -81,18 +80,17 @@ compileModule tell project maybeDocsPath answersMVar ifacesMVar name info =

81 else

80 else

82 do tell (Progress.CompileFileStart name)

81 do tell (Progress.CompileFileStart name)

83 let pkg = Project.getName project

82 let pkg = Project.getName project

84− let docs = toDocsFlag name project maybeDocsPath

85 let imports = makeImports project info

83 let imports = makeImports project info

86 ifaces <- readMVar ifacesMVar

84 ifaces <- readMVar ifacesMVar

87 let source = Plan._src info

85 let source = Plan._src info

88− case Compiler.compile docs pkg imports ifaces source of

86+ case Compiler.compile pkg imports ifaces source of

89 (_warnings, Left errors) ->

87 (_warnings, Left errors) ->

90 do tell (Progress.CompileFileEnd name Progress.Bad)

88 do tell (Progress.CompileFileEnd name Progress.Bad)

91 let time = Plan._time info

89 let time = Plan._time info

92 let path = Plan._path info

90 let path = Plan._path info

93 putMVar mvar (Bad path time source errors)

91 putMVar mvar (Bad path time source errors)

94

92

95− (_warnings, Right result@(Compiler.Artifacts elmi _ _)) ->

93+ (_warnings, Right result@(Compiler.Artifacts elmi _)) ->

96 do tell (Progress.CompileFileEnd name Progress.Good)

94 do tell (Progress.CompileFileEnd name Progress.Good)

97 let canonicalName = ModuleName.Canonical pkg name

95 let canonicalName = ModuleName.Canonical pkg name

98 lock <- takeMVar ifacesMVar

96 lock <- takeMVar ifacesMVar

@@ -103,38 +101,6 @@ compileModule tell project maybeDocsPath answersMVar ifacesMVar name info =

103

101

104

102

105

103

106−-- TO DOCS FLAG

107−

108−

109−toDocsFlag :: ModuleName.Raw -> Project -> Maybe FilePath -> Compiler.DocsFlag

110−toDocsFlag name project maybeDocsPath =

111− case maybeDocsPath of

112− Nothing ->

113− Compiler.NoDocs

114−

115− Just _ ->

116− case project of

117− Project.App _ ->

118− Compiler.NoDocs

119−

120− Project.Pkg info ->

121− if isExposed name (Project._pkg_exposed info) then

122− Compiler.YesDocs

123− else

124− Compiler.NoDocs

125−

126−

127−isExposed :: ModuleName.Raw -> Project.Exposed -> Bool

128−isExposed name exposed =

129− case exposed of

130− Project.ExposedList modules ->

131− elem name modules

132−

133− Project.ExposedDict chunks ->

134− elem name (concatMap snd chunks)

135−

136−

137−

138-- IMPORTS

104-- IMPORTS

139

105

140

106

builder/src/File/Plan.hs+5−13

@@ -6,6 +6,7 @@ module File.Plan

6 )

7 where

8

9+

9import Control.Concurrent (forkIO)

10import Control.Concurrent (forkIO)

10import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

11import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

11import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)

12import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)

@@ -35,11 +36,11 @@ import qualified Stuff.Paths

35type Dict value = Map.Map ModuleName.Raw value

36type Dict value = Map.Map ModuleName.Raw value

36

37

38

38−plan :: Maybe FilePath -> Summary.Summary -> Crawl.Result -> Task.Task (Dict Info, I.Interfaces)

39+plan :: Summary.Summary -> Crawl.Result -> Task.Task (Dict Info, I.Interfaces)

39−plan docs (Summary.Summary root project _ ifaces _) (Crawl.Graph _ locals _ foreigns _) =

40+plan (Summary.Summary root project _ ifaces _) (Crawl.Graph _ locals _ foreigns _) =

40 liftIO $

41 liftIO $

41 do queue <- newChan

42 do queue <- newChan

42− let env = Env queue root (Project.getName project) docs

43+ let env = Env queue root (Project.getName project)

43

44

44 mvar <- newEmptyMVar

45 mvar <- newEmptyMVar

45 statusMVars <- Map.traverseWithKey (getStatus env mvar foreigns) locals

46 statusMVars <- Map.traverseWithKey (getStatus env mvar foreigns) locals

@@ -57,7 +58,6 @@ data Env =

57 { _queue :: Chan Msg

58 { _queue :: Chan Msg

58 , _root :: FilePath

59 , _root :: FilePath

59 , _pkg :: Pkg.Name

60 , _pkg :: Pkg.Name

60− , _docs :: Maybe FilePath

61 }

62

63

@@ -100,29 +100,21 @@ getStatus env statusMVars foreigns name (Header.Info path time src deps) =

100 info <- foldM (addDep statuses foreigns) (Info path time src [] [] []) deps

101

102 let elmi = Stuff.Paths.elmi (_root env) name

103− let docs = Stuff.Paths.moduleDocs (_root env) name

104

103

105 case _dirty info of

104 case _dirty info of

106 _ : _ ->

105 _ : _ ->

107 do remove elmi

106 do remove elmi

108− remove docs

109 return (Just info)

107 return (Just info)

110

108

111 [] ->

109 [] ->

112 do freshElmi <- isFresh time elmi

110 do freshElmi <- isFresh time elmi

113− freshDocs <-

114− case _docs env of

115− Nothing -> return True

116− Just _ -> isFresh time docs

117−

118− if name /= "Main" && freshElmi && freshDocs

111+ if name /= "Main" && freshElmi

119 then

112 then

120 do let canonical = ModuleName.Canonical (_pkg env) name

113 do let canonical = ModuleName.Canonical (_pkg env) name

121 writeChan (_queue env) (Get canonical elmi)

114 writeChan (_queue env) (Get canonical elmi)

122 return Nothing

115 return Nothing

123 else

116 else

124 do remove elmi

117 do remove elmi

125− remove docs

126 return (Just info)

118 return (Just info)

127

119

128 return mvar

120 return mvar

builder/src/Generate/Artifacts.hs+3−22

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

1module Generate.Artifacts

2 ( ignore

3 , write

4− , writeDocs

5 )

4 )

6 where

5 where

7

6

@@ -11,15 +10,12 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)

11import Control.Monad (foldM, void)

10import Control.Monad (foldM, void)

12import Control.Monad.Except (liftIO)

11import Control.Monad.Except (liftIO)

13import qualified Data.Binary as Binary

12import qualified Data.Binary as Binary

13+import qualified Data.ByteString.UTF8 as BS_UTF8

14import Data.Map (Map)

15import qualified Data.Map as Map

16−import qualified Data.Maybe as Maybe

17−import qualified Data.Text.Encoding as Text

18

16

19import qualified Elm.Compiler as Compiler

17import qualified Elm.Compiler as Compiler

20−import qualified Elm.Docs as Docs

21import qualified Elm.ModuleName as ModuleName

18import qualified Elm.ModuleName as ModuleName

22−import qualified Json.Encode as Encode

23

19

24import File.Compile (Answer(..))

20import File.Compile (Answer(..))

25import qualified Reporting.Exit.Compile as E

21import qualified Reporting.Exit.Compile as E

@@ -48,7 +44,7 @@ ignore answers =

48write :: FilePath -> Map ModuleName.Raw Answer -> Task.Task (Map ModuleName.Raw Compiler.Artifacts)

44write :: FilePath -> Map ModuleName.Raw Answer -> Task.Task (Map ModuleName.Raw Compiler.Artifacts)

49write root answers =

45write root answers =

50 let

46 let

51− writer name result@(Compiler.Artifacts elmi elmo _) =

47+ writer name result@(Compiler.Artifacts elmi elmo) =

52 do mvar <- newEmptyMVar

48 do mvar <- newEmptyMVar

53 void $ forkIO $

49 void $ forkIO $

54 do Binary.encodeFile (Path.elmi root name) elmi

50 do Binary.encodeFile (Path.elmi root name) elmi

@@ -60,21 +56,6 @@ write root answers =

60 liftIO $ traverse readMVar mvars

56 liftIO $ traverse readMVar mvars

61

57

62

58

63−writeDocs :: Map ModuleName.Raw Compiler.Artifacts -> FilePath -> Task.Task Docs.Documentation

64−writeDocs results path =

65− let

66− getDocs (Compiler.Artifacts _ _ docs) =

67− docs

68− in

69− case Maybe.mapMaybe getDocs (Map.elems results) of

70− [] ->

71− return Map.empty

72−

73− docs ->

74− do liftIO $ Encode.writeUgly path $ Encode.list Docs.encode docs

75− return $ Docs.toDict docs

76−

77−

78

59

79-- GATHER

60-- GATHER

80

61

@@ -102,7 +83,7 @@ gatherHelp onGood summary (name, answer) =

102 return summary

83 return summary

103

84

104 Bad path time src errors ->

85 Bad path time src errors ->

105− do let err = E.Exit name path time (Text.decodeUtf8 src) errors

86+ do let err = E.Exit name path time (BS_UTF8.toString src) errors

106 return (addErr err summary)

87 return (addErr err summary)

107

88

108 Good result ->

89 Good result ->

compiler/src/Compile.hs+5−29

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

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2module Compile

3− ( DocsFlag(..)

4− , compile

3+ ( compile

5 , Artifacts(..)

4 , Artifacts(..)

6 )

5 )

7 where

6 where

@@ -14,13 +13,12 @@ import qualified Data.Name as Name

14import qualified AST.Canonical as Can

13import qualified AST.Canonical as Can

15import qualified AST.Optimized as Opt

14import qualified AST.Optimized as Opt

16import qualified Canonicalize.Module as Canonicalize

15import qualified Canonicalize.Module as Canonicalize

17−import qualified Elm.Docs as Docs

18import qualified Elm.Interface as I

16import qualified Elm.Interface as I

19import qualified Elm.ModuleName as ModuleName

17import qualified Elm.ModuleName as ModuleName

20import qualified Elm.Package as Pkg

18import qualified Elm.Package as Pkg

21import qualified Nitpick.PatternMatches as PatternMatches

19import qualified Nitpick.PatternMatches as PatternMatches

22import qualified Optimize.Module as Optimize

20import qualified Optimize.Module as Optimize

23−import qualified Parse.Parse as Parse

21+import qualified Parse.Module as Parse

24import qualified Reporting.Error as Error

22import qualified Reporting.Error as Error

25import qualified Reporting.Render.Type.Localizer as L

23import qualified Reporting.Render.Type.Localizer as L

26import qualified Reporting.Result as Result

24import qualified Reporting.Result as Result

@@ -47,15 +45,14 @@ data Artifacts =

47 Artifacts

45 Artifacts

48 { _elmi :: I.Interface

46 { _elmi :: I.Interface

49 , _elmo :: Opt.Graph

47 , _elmo :: Opt.Graph

50− , _docs :: Maybe Docs.Module

51 }

48 }

52

49

53

50

54−compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts

51+compile :: Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts

55−compile flag pkg importDict interfaces source =

52+compile pkg importDict interfaces source =

56 do

53 do

57 valid <- Result.mapError Error.Syntax $

54 valid <- Result.mapError Error.Syntax $

58− Parse.program pkg source

55+ Parse.fromByteString pkg source

59

56

60 canonical <- Result.mapError Error.Canonicalize $

57 canonical <- Result.mapError Error.Canonicalize $

61 Canonicalize.canonicalize pkg importDict interfaces valid

58 Canonicalize.canonicalize pkg importDict interfaces valid

@@ -71,14 +68,10 @@ compile flag pkg importDict interfaces source =

71 graph <- Result.mapError (Error.Main localizer) $

68 graph <- Result.mapError (Error.Main localizer) $

72 Optimize.optimize annotations canonical

69 Optimize.optimize annotations canonical

73

70

74− documentation <-

75− genarateDocs flag canonical

76−

77 Result.ok $

71 Result.ok $

78 Artifacts

72 Artifacts

79 { _elmi = I.fromModule annotations canonical

73 { _elmi = I.fromModule annotations canonical

80 , _elmo = graph

74 , _elmo = graph

81− , _docs = documentation

82 }

75 }

83

76

84

77

@@ -108,20 +101,3 @@ exhaustivenessCheck canonical =

108

101

109 Right () ->

102 Right () ->

110 Result.ok ()

103 Result.ok ()

111−

112−

113−

114−-- DOCUMENTATION

115−

116−

117−data DocsFlag = YesDocs | NoDocs

118−

119−

120−genarateDocs :: DocsFlag -> Can.Module -> Result.Result i w Error.Error (Maybe Docs.Module)

121−genarateDocs flag modul =

122− case flag of

123− NoDocs ->

124− Result.ok Nothing

125−

126− YesDocs ->

127− Just <$> Docs.fromModule modul

compiler/src/Elm/Compiler.hs+37−32

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

1{-# LANGUAGE OverloadedStrings #-}

2module Elm.Compiler

3− ( version

4− , Compile.DocsFlag(..)

5− , Compile.Artifacts(..)

3+ ( Compile.Artifacts(..)

6 , compile

4 , compile

7 , Error.Error

5 , Error.Error

8 , errorsToDoc

6 , errorsToDoc

@@ -14,52 +12,43 @@ module Elm.Compiler

14

12

15import qualified Data.ByteString as BS

13import qualified Data.ByteString as BS

16import qualified Data.Map as Map

14import qualified Data.Map as Map

17−import qualified Data.Text as Text

15+import qualified Data.Name as Name

16+import qualified Data.Utf8 as Utf8

18

17

19import qualified Compile

18import qualified Compile

20−import qualified Elm.Compiler.Version

21import qualified Elm.Interface as I

19import qualified Elm.Interface as I

22import qualified Elm.ModuleName as ModuleName

20import qualified Elm.ModuleName as ModuleName

23import qualified Elm.Package as Pkg

21import qualified Elm.Package as Pkg

24−import qualified Json.Encode as Encode

22+import qualified Json.Encode as E

23+import Json.Encode ((==>))

24+import qualified Reporting.Annotation as A

25import qualified Reporting.Doc as D

26import qualified Reporting.Error as Error

27import qualified Reporting.Render.Code as Code

28−import qualified Reporting.Region as Region

29import qualified Reporting.Report as Report

28import qualified Reporting.Report as Report

30import qualified Reporting.Result as Result

29import qualified Reporting.Result as Result

31import qualified Reporting.Warning as Warning

30import qualified Reporting.Warning as Warning

32

31

33

32

34

33

35−-- VERSION

36−

37−

38−version :: Pkg.Version

39−version =

40− Elm.Compiler.Version.version

41−

42−

43−

44-- COMPILE

34-- COMPILE

45

35

46

36

47compile

37compile

48− :: Compile.DocsFlag

49− -> Pkg.Name

38+ :: Pkg.Name

50 -> Map.Map ModuleName.Raw ModuleName.Canonical

39 -> Map.Map ModuleName.Raw ModuleName.Canonical

51 -> I.Interfaces

40 -> I.Interfaces

52 -> BS.ByteString

41 -> BS.ByteString

53 -> ( [Warning.Warning], Either [Error.Error] Compile.Artifacts )

42 -> ( [Warning.Warning], Either [Error.Error] Compile.Artifacts )

54−compile docsFlag pkg importDict interfaces source =

43+compile pkg importDict interfaces source =

55− Result.run $ Compile.compile docsFlag pkg importDict interfaces source

44+ Result.run $ Compile.compile pkg importDict interfaces source

56

45

57

46

58

47

59-- ERRORS TO DOC

48-- ERRORS TO DOC

60

49

61

50

62−errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> D.Doc

51+errorsToDoc :: FilePath -> String -> [Error.Error] -> D.Doc

63errorsToDoc filePath source errors =

52errorsToDoc filePath source errors =

64 let

53 let

65 reports =

54 reports =

@@ -72,23 +61,39 @@ errorsToDoc filePath source errors =

72-- ERRORS TO JSON

61-- ERRORS TO JSON

73

62

74

63

75−errorsToJson :: ModuleName.Raw -> FilePath -> Text.Text -> [Error.Error] -> Encode.Value

64+errorsToJson :: ModuleName.Raw -> FilePath -> String -> [Error.Error] -> E.Value

76errorsToJson moduleName filePath source errors =

65errorsToJson moduleName filePath source errors =

77 let

66 let

78 reports =

67 reports =

79 concatMap (Error.toReports (Code.toSource source)) errors

68 concatMap (Error.toReports (Code.toSource source)) errors

80 in

69 in

81− Encode.object

70+ E.object

82− [ ("path", Encode.text (Text.pack filePath))

71+ [ "path" ==> E.string (Utf8.fromChars filePath)

83− , ("name", Encode.name moduleName)

72+ , "name" ==> E.string (Name.toUtf8 moduleName)

84− , ("problems", Encode.array (map reportToJson reports))

73+ , "problems" ==> E.array (map reportToJson reports)

85 ]

74 ]

86

75

87

76

88−reportToJson :: Report.Report -> Encode.Value

77+reportToJson :: Report.Report -> E.Value

89reportToJson (Report.Report title region _sgstns message) =

78reportToJson (Report.Report title region _sgstns message) =

90− Encode.object

79+ E.object

91− [ ("title", Encode.text (Text.pack title))

80+ [ "title" ==> E.string (Utf8.fromChars title)

92− , ("region", Region.encode region)

81+ , "region" ==> encodeRegion region

93− , ("message", D.encode message)

82+ , "message" ==> D.encode message

83+ ]

84+

85+

86+encodeRegion :: A.Region -> E.Value

87+encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =

88+ E.object

89+ [ "start" ==>

90+ E.object

91+ [ ("line", E.int (fromIntegral sr))

92+ , ("column", E.int (fromIntegral sc))

93+ ]

94+ , "end" ==>

95+ E.object

96+ [ ("line", E.int (fromIntegral er))

97+ , ("column", E.int (fromIntegral ec))

98+ ]

94− ]

99+ ]

terminal/src/Develop.hs+1−1

@@ -167,7 +167,7 @@ compileToHtmlBuilder file =

167

168 void $ Task.try reporter $

169 do summary <- Project.getRoot

170− Project.compile Output.Dev Output.Client output Nothing summary [file]

170+ Project.compile Output.Dev Output.Client output summary [file]

171

172 result <- takeMVar mvar1

173 case result of

terminal/src/Develop/StaticFiles/Build.hs+1−1

@@ -36,7 +36,7 @@ compile =

36 Task.run reporter $

37 do summary <- Project.getRoot

38 let jsOutput = Just (Output.JavaScript Nothing tempFileName)

39− Project.compile Output.Prod Output.Client jsOutput Nothing summary rootPaths

39+ Project.compile Output.Prod Output.Client jsOutput summary rootPaths

40

41 result <- BS.readFile tempFileName

42 seq (BS.length result) (Dir.removeFile tempFileName)

terminal/src/Make.hs+2−2

@@ -36,12 +36,12 @@ data Flags =

36

37

38run :: [FilePath] -> Flags -> IO ()

39−run paths (Flags debug optimize output report docs) =

39+run paths (Flags debug optimize output report _docs) =

40 do reporter <- toReporter report

41 Task.run reporter $

42 do mode <- toMode debug optimize

43 summary <- Project.getRoot

44− Project.compile mode Output.Client output docs summary paths

44+ Project.compile mode Output.Client output summary paths

45

46

47toMode :: Bool -> Bool -> Task.Task Output.Mode