git.iko.soy/elk
on master help sign in
get reactor index generation compiling again
b9e8c7aEvan Czaplicki
terminal/src/Develop/Generate/Index.hs+101−76
compare with master
unifiedsplit
@@ -1,36 +1,31 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Develop.Generate.Index
3module Develop.Generate.Index
4− ( get
4+ ( generate
5 )
5 )
6 where
6 where
7
7
8
8
9import Control.Monad (filterM)
9import Control.Monad (filterM)
10import qualified Data.ByteString.Builder as B
10import qualified Data.ByteString.Builder as B
11−import qualified Data.Map as Map
11+import qualified Data.List as List
12−import qualified Data.Text as Text
13−import qualified Data.Text.IO as Text
14import qualified System.Directory as Dir
12import qualified System.Directory as Dir
15import System.FilePath ((</>), splitDirectories, takeExtension)
13import System.FilePath ((</>), splitDirectories, takeExtension)
16
14
17import qualified Develop.Generate.Help as Help
15import qualified Develop.Generate.Help as Help
18−import qualified Elm.Package as Pkg
16+import qualified Elm.Outline as Outline
19−import qualified Elm.Project.Json as Project
20−import qualified Elm.Project.Summary as Summary
21import qualified Json.Encode as E
17import qualified Json.Encode as E
22−import qualified Reporting.Progress as Progress
18+import Json.Encode ((==>))
23−import qualified Reporting.Task as Task
24−import qualified Stuff.Verify as Verify
19+import qualified Stuff
25
20
26
21
27
22
28−-- GET
23+-- GENERATE
29
24
30
25
31−get :: FilePath -> FilePath -> IO B.Builder
26+generate :: FilePath -> IO B.Builder
32−get root pwd =
27+generate pwd =
33− do flags <- getFlags root pwd
28+ do flags <- getFlags pwd
34 return $ Help.makePageHtml "Index" (Just (encode flags))
29 return $ Help.makePageHtml "Index" (Just (encode flags))
35
30
36
31
@@ -43,60 +38,31 @@ data Flags =
43 { _root :: FilePath
38 { _root :: FilePath
44 , _pwd :: [String]
39 , _pwd :: [String]
45 , _dirs :: [FilePath]
40 , _dirs :: [FilePath]
46− , _files :: [(FilePath, Bool)]
41+ , _files :: [File]
47− , _readme :: Maybe Text.Text
42+ , _readme :: Maybe String
48− , _project :: Maybe Project.Project
43+ , _outline :: Maybe Outline.Outline
49− , _exactDeps :: Map.Map Pkg.Name Pkg.Version
50 }
44 }
51
45
52
46
53−
47+data File =
54−-- JSON
48+ File
55−
49+ { _path :: FilePath
56−
50+ , _runnable :: Bool
57−encode :: Flags -> E.Value
51+ }
58−encode (Flags root pwd dirs files readme project exactDeps) =
59− E.object
60− [ ( "root", encodeFilePath root )
61− , ( "pwd", E.list encodeFilePath pwd )
62− , ( "dirs", E.list encodeFilePath dirs )
63− , ( "files", E.list encodeFile files )
64− , ( "readme", maybe E.null E.text readme )
65− , ( "project", maybe E.null Project.encode project )
66− , ( "exactDeps", E.dict Pkg.toText Pkg.encodeVersion exactDeps)
67− ]
68−
69−
70−encodeFilePath :: FilePath -> E.Value
71−encodeFilePath filePath =
72− E.text (Text.pack filePath)
73−
74−
75−encodeFile :: (FilePath, Bool) -> E.Value
76−encodeFile (file, hasMain) =
77− E.object
78− [ ("name", encodeFilePath file)
79− , ("runnable", E.bool hasMain)
80− ]
81
52
82
53
83
54
84-- GET FLAGS
55-- GET FLAGS
85
56
86
57
87−getFlags :: FilePath -> FilePath -> IO Flags
58+getFlags :: FilePath -> IO Flags
88−getFlags root pwd =
59+getFlags pwd =
89− do (dirs, files) <- getDirsAndFiles pwd
60+ do contents <- Dir.getDirectoryContents pwd
61+ root <- Dir.getCurrentDirectory
62+ dirs <- getDirs pwd contents
63+ files <- getFiles pwd contents
90 readme <- getReadme pwd
64 readme <- getReadme pwd
91− exists <- Dir.doesFileExist (root </> "elm.json")
65+ outline <- getOutline
92−
93− maybeSummary <-
94− if exists then
95− Task.try Progress.silentReporter $
96− Verify.verify root =<< Project.read (root </> "elm.json")
97− else
98− return Nothing
99−
100 return $
66 return $
101 Flags
67 Flags
102 { _root = root
68 { _root = root
@@ -104,35 +70,94 @@ getFlags root pwd =
104 , _dirs = dirs
70 , _dirs = dirs
105 , _files = files
71 , _files = files
106 , _readme = readme
72 , _readme = readme
107− , _project = fmap Summary._project maybeSummary
73+ , _outline = outline
108− , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary
109 }
74 }
110
75
111
76
77+
78+-- README
79+
80+
112−getReadme :: FilePath -> IO (Maybe Text.Text)
81+getReadme :: FilePath -> IO (Maybe String)
113getReadme dir =
82getReadme dir =
114 do let readmePath = dir </> "README.md"
83 do let readmePath = dir </> "README.md"
115 exists <- Dir.doesFileExist readmePath
84 exists <- Dir.doesFileExist readmePath
116 if exists
85 if exists
117− then Just <$> Text.readFile readmePath
86+ then Just <$> readFile readmePath
118 else return Nothing
87 else return Nothing
119
88
120
89
121−getDirsAndFiles :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
122−getDirsAndFiles pwd =
123− do contents <- Dir.getDirectoryContents pwd
124− dirs <- filterM (Dir.doesDirectoryExist . (pwd </>)) contents
125− filePaths <- filterM (Dir.doesFileExist . (pwd </>)) contents
126− files <- mapM (inspectFile pwd) filePaths
127− return (dirs, files)
128
90
91+-- GET DIRECTORIES
129
92
130−inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)
131−inspectFile pwd path =
132− if takeExtension path == ".elm" then
133− do source <- Text.readFile (pwd </> path)
134− let hasMain = Text.isInfixOf "\nmain " source
135− return (path, hasMain)
136
93
94+getDirs :: FilePath -> [FilePath] -> IO [FilePath]
95+getDirs pwd contents =
96+ filterM (Dir.doesDirectoryExist . (pwd </>)) contents
97+
98+
99+
100+-- GET FILES
101+
102+
103+getFiles :: FilePath -> [FilePath] -> IO [File]
104+getFiles pwd contents =
105+ do paths <- filterM (Dir.doesFileExist . (pwd </>)) contents
106+ mapM (toFile pwd) paths
107+
108+
109+toFile :: FilePath -> FilePath -> IO File
110+toFile pwd path =
111+ if takeExtension path == ".elm" then
112+ do source <- readFile (pwd </> path)
113+ let hasMain = List.isInfixOf "\nmain " source
114+ return (File path hasMain)
137 else
115 else
138− return (path, False)
116+ return (File path False)
117+
118+
119+
120+-- GET OUTLINE
121+
122+
123+getOutline :: IO (Maybe Outline.Outline)
124+getOutline =
125+ do maybeRoot <- Stuff.findRoot
126+ case maybeRoot of
127+ Nothing ->
128+ return Nothing
129+
130+ Just root ->
131+ do result <- Outline.read root
132+ case result of
133+ Left _ -> return Nothing
134+ Right outline -> return (Just outline)
135+
136+
137+
138+-- ENCODE
139+
140+
141+encode :: Flags -> E.Value
142+encode (Flags root pwd dirs files readme outline) =
143+ E.object
144+ [ "root" ==> encodeFilePath root
145+ , "pwd" ==> E.list encodeFilePath pwd
146+ , "dirs" ==> E.list encodeFilePath dirs
147+ , "files" ==> E.list encodeFile files
148+ , "readme" ==> maybe E.null E.chars readme
149+ , "outline" ==> maybe E.null Outline.encode outline
150+ ]
151+
152+
153+encodeFilePath :: FilePath -> E.Value
154+encodeFilePath filePath =
155+ E.chars filePath
156+
157+
158+encodeFile :: File -> E.Value
159+encodeFile (File path hasMain) =
160+ E.object
161+ [ "name" ==> encodeFilePath path
162+ , "runnable" ==> E.bool hasMain
163+ ]