@@ -1,50 +1,52 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Develop.Generate.Index
4− ( toHtml
5− , getProject
6− , moveToRoot
4+ ( get
75 )
86 where
97
8+
109import Control.Monad (filterM)
1110import qualified Data.ByteString.Builder as B
12−import qualified Data.ByteString.Lazy.UTF8 as Utf8
13−import qualified Data.List as List
11+import qualified Data.Map as Map
1412import qualified Data.Text as Text
1513import qualified Data.Text.IO as Text
1614import qualified System.Directory as Dir
17−import System.FilePath ((</>), joinPath, splitDirectories, takeExtension)
18−import qualified Text.Blaze.Html5 as H
15+import System.FilePath ((</>), splitDirectories, takeExtension)
1916
2017import qualified Develop.Generate.Help as Help
21−import qualified Develop.StaticFiles as StaticFiles
18+import qualified Elm.Package as Pkg
19+import qualified Elm.Project.Json as Project
20+import qualified Elm.Project.Summary as Summary
2221import 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
2325
2426
2527
26−-- PROJECT
28+-- GET
2729
2830
29−data Project =
30− Project
31− { _root :: FilePath
32− , _info :: PerhapsInfo
33− }
31+get :: FilePath -> FilePath -> IO B.Builder
32+get root pwd =
33+ do flags <- getFlags root pwd
34+ return $ Help.makePageHtml "Index" (E.encode (encode flags))
3435
3536
36−data PerhapsInfo
37− = Bad (Maybe FilePath)
38− | Good Info
3937
38+-- FLAGS
4039
41−data Info =
42− Info
43− { _pwd :: [String]
40+
41+data Flags =
42+ Flags
43+ { _root :: FilePath
44+ , _pwd :: [String]
4445 , _dirs :: [FilePath]
4546 , _files :: [(FilePath, Bool)]
4647 , _readme :: Maybe Text.Text
47− , _config :: Text.Text
48+ , _project :: Maybe Project.Project
49+ , _exactDeps :: Map.Map Pkg.Name Pkg.Version
4850 }
4951
5052
@@ -52,17 +54,17 @@ data Info =
5254-- JSON
5355
5456
55−goodToJson :: FilePath -> Info -> String
56−goodToJson root (Info pwd dirs files readme config) =
57− Utf8.toString $ B.toLazyByteString $ E.encodeUgly $
58− E.object
59− [ ( "root", encodeFilePath root )
60− , ( "pwd", E.list encodeFilePath pwd )
61− , ( "dirs", E.list encodeFilePath dirs )
62− , ( "files", E.list encodeFile files )
63− , ( "readme", maybe E.null E.text readme )
64− , ( "config", E.text config )
65− ]
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+ ]
6668
6769
6870encodeFilePath :: FilePath -> E.Value
@@ -72,102 +74,37 @@ encodeFilePath filePath =
7274
7375encodeFile :: (FilePath, Bool) -> E.Value
7476encodeFile (file, hasMain) =
75− E.array [ encodeFilePath file, E.bool hasMain ]
76−
77−
78−badJson :: FilePath -> Maybe FilePath -> String
79−badJson root potentialRoot =
80− Utf8.toString $ B.toLazyByteString $ E.encodeUgly $
81− E.object
82− [ ( "root", encodeFilePath root )
83− , ( "suggestion", maybe E.null encodeFilePath potentialRoot )
84− ]
85−
86−
77+ E.object
78+ [ ("name", encodeFilePath file)
79+ , ("runnable", E.bool hasMain)
80+ ]
8781
88−-- GENERATE HTML
8982
9083
91−toHtml :: Project -> H.Html
92−toHtml (Project root perhapsInfo) =
93− case perhapsInfo of
94− Good info@(Info pwd _ _ _ _) ->
95− Help.makeHtml
96− (List.intercalate "/" ("~" : pwd))
97− ("/" ++ StaticFiles.elmPath)
98− ("Elm.Index.fullscreen(" ++ goodToJson root info ++ ");")
84+-- GET FLAGS
9985
100− Bad suggestion ->
101− Help.makeHtml
102− (maybe "New Project!" (const "Existing Project?") suggestion)
103− ("/" ++ StaticFiles.elmPath)
104− ("Elm.Start.fullscreen(" ++ badJson root suggestion ++ ");")
10586
87+getFlags :: FilePath -> FilePath -> IO Flags
88+getFlags root pwd =
89+ do (dirs, files) <- getDirsAndFiles pwd
90+ readme <- getReadme pwd
10691
92+ maybeSummary <-
93+ Task.run Progress.silentReporter $
94+ Verify.verify root =<< Project.read "elm.json"
10795
108−-- GET PROJECT
109−
110−
111−getProject :: FilePath -> IO Project
112−getProject directory =
113− do root <- Dir.getCurrentDirectory
114− exists <- Dir.doesFileExist "elm.json"
115− Project root <$>
116− case exists of
117− False ->
118− Bad <$> findNearestConfig (splitDirectories root)
119−
120− True ->
121− do json <- Text.readFile "elm.json"
122− Good <$> getInfo json directory
123−
124−
125−findNearestConfig :: [String] -> IO (Maybe FilePath)
126−findNearestConfig dirs =
127− if null dirs then
128− return Nothing
129−
130− else
131− do exists <- Dir.doesFileExist (joinPath dirs </> "elm.json")
132− if exists
133− then return (Just (joinPath dirs))
134− else findNearestConfig (init dirs)
135−
136−
137−moveToRoot :: IO ()
138−moveToRoot =
139− do subDir <- Dir.getCurrentDirectory
140− maybeRoot <- findNearestConfig (splitDirectories subDir)
141− case maybeRoot of
142− Nothing ->
143− return ()
144−
145− Just root ->
146− Dir.setCurrentDirectory root
147−
148−
149−
150−-- GET INFO
151−
152−
153−getInfo :: Text.Text -> FilePath -> IO Info
154−getInfo config directory =
155− do (dirs, files) <- getDirectoryInfo directory
156− readme <- getReadme directory
15796 return $
158− Info
159− { _pwd = dropWhile ("." ==) (splitDirectories directory)
97+ Flags
98+ { _root = root
99+ , _pwd = dropWhile ("." ==) (splitDirectories pwd)
160100 , _dirs = dirs
161101 , _files = files
162102 , _readme = readme
163− , _config = config
103+ , _project = fmap Summary._project maybeSummary
104+ , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary
164105 }
165106
166107
167−
168−-- README
169−
170−
171108getReadme :: FilePath -> IO (Maybe Text.Text)
172109getReadme dir =
173110 do let readmePath = dir </> "README.md"
@@ -177,28 +114,21 @@ getReadme dir =
177114 else return Nothing
178115
179116
180−
181−-- DIRECTORIES / FILES
182−
183−
184−getDirectoryInfo :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
185−getDirectoryInfo dir =
186− do contents <- Dir.getDirectoryContents dir
187−
188− allDirs <- filterM (Dir.doesDirectoryExist . (dir </>)) contents
189− rawFiles <- filterM (Dir.doesFileExist . (dir </>)) contents
190−
191− files <- mapM (inspectFile dir) rawFiles
192−
193− return (allDirs, files)
117+getDirsAndFiles :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
118+getDirsAndFiles pwd =
119+ do contents <- Dir.getDirectoryContents pwd
120+ dirs <- filterM (Dir.doesDirectoryExist . (pwd </>)) contents
121+ filePaths <- filterM (Dir.doesFileExist . (pwd </>)) contents
122+ files <- mapM (inspectFile pwd) filePaths
123+ return (dirs, files)
194124
195125
196126inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)
197−inspectFile dir filePath =
198− if takeExtension filePath == ".elm" then
199− do source <- Text.readFile (dir </> filePath)
127+inspectFile pwd path =
128+ if takeExtension path == ".elm" then
129+ do source <- Text.readFile (pwd </> path)
200130 let hasMain = Text.isInfixOf "\nmain " source
201− return (filePath, hasMain)
131+ return (path, hasMain)
202132
203133 else
204− return (filePath, False)
134+ return (path, False)