@@ -1,36 +1,31 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Develop.Generate.Index
4− ( get
4+ ( generate
55 )
66 where
77
88
99import Control.Monad (filterM)
1010import qualified Data.ByteString.Builder as B
11−import qualified Data.Map as Map
12−import qualified Data.Text as Text
13−import qualified Data.Text.IO as Text
11+import qualified Data.List as List
1412import qualified System.Directory as Dir
1513import System.FilePath ((</>), splitDirectories, takeExtension)
1614
1715import qualified Develop.Generate.Help as Help
18−import qualified Elm.Package as Pkg
19−import qualified Elm.Project.Json as Project
20−import qualified Elm.Project.Summary as Summary
16+import qualified Elm.Outline as Outline
2117import qualified Json.Encode as E
22−import qualified Reporting.Progress as Progress
23−import qualified Reporting.Task as Task
24−import qualified Stuff.Verify as Verify
18+import Json.Encode ((==>))
19+import qualified Stuff
2520
2621
2722
28−-- GET
23+-- GENERATE
2924
3025
31−get :: FilePath -> FilePath -> IO B.Builder
32−get root pwd =
33− do flags <- getFlags root pwd
26+generate :: FilePath -> IO B.Builder
27+generate pwd =
28+ do flags <- getFlags pwd
3429 return $ Help.makePageHtml "Index" (Just (encode flags))
3530
3631
@@ -43,60 +38,31 @@ data Flags =
4338 { _root :: FilePath
4439 , _pwd :: [String]
4540 , _dirs :: [FilePath]
46− , _files :: [(FilePath, Bool)]
47− , _readme :: Maybe Text.Text
48− , _project :: Maybe Project.Project
49− , _exactDeps :: Map.Map Pkg.Name Pkg.Version
41+ , _files :: [File]
42+ , _readme :: Maybe String
43+ , _outline :: Maybe Outline.Outline
5044 }
5145
5246
53−
54−-- JSON
55−
56−
57−encode :: Flags -> E.Value
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− ]
47+data File =
48+ File
49+ { _path :: FilePath
50+ , _runnable :: Bool
51+ }
8152
8253
8354
8455-- GET FLAGS
8556
8657
87−getFlags :: FilePath -> FilePath -> IO Flags
88−getFlags root pwd =
89− do (dirs, files) <- getDirsAndFiles pwd
58+getFlags :: FilePath -> IO Flags
59+getFlags pwd =
60+ do contents <- Dir.getDirectoryContents pwd
61+ root <- Dir.getCurrentDirectory
62+ dirs <- getDirs pwd contents
63+ files <- getFiles pwd contents
9064 readme <- getReadme pwd
91− exists <- Dir.doesFileExist (root </> "elm.json")
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−
65+ outline <- getOutline
10066 return $
10167 Flags
10268 { _root = root
@@ -104,35 +70,94 @@ getFlags root pwd =
10470 , _dirs = dirs
10571 , _files = files
10672 , _readme = readme
107− , _project = fmap Summary._project maybeSummary
108− , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary
73+ , _outline = outline
10974 }
11075
11176
112−getReadme :: FilePath -> IO (Maybe Text.Text)
77+
78+-- README
79+
80+
81+getReadme :: FilePath -> IO (Maybe String)
11382getReadme dir =
11483 do let readmePath = dir </> "README.md"
11584 exists <- Dir.doesFileExist readmePath
11685 if exists
117− then Just <$> Text.readFile readmePath
86+ then Just <$> readFile readmePath
11887 else return Nothing
11988
12089
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)
12890
91+-- GET DIRECTORIES
12992
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)
13693
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)
137115 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+ ]