git.iko.soy/elk
on 8f7c3cd help sign in
elk/cli/src/Develop/Generate/Index.hs
204 lines 4.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Develop.Generate.Index
4 ( toHtml
5 , getProject
6 , moveToRoot
7 )
8 where
10import Control.Monad (filterM)
11import qualified Data.ByteString.Builder as B
12import qualified Data.ByteString.Lazy.UTF8 as Utf8
13import qualified Data.List as List
14import qualified Data.Text as Text
15import qualified Data.Text.IO as Text
16import qualified System.Directory as Dir
17import System.FilePath ((</>), joinPath, splitDirectories, takeExtension)
18import qualified Text.Blaze.Html5 as H
20import qualified Develop.Generate.Help as Help
21import qualified Develop.StaticFiles as StaticFiles
22import qualified Json.Encode as E
26-- PROJECT
29data Project =
30 Project
31 { _root :: FilePath
32 , _info :: PerhapsInfo
33 }
36data PerhapsInfo
37 = Bad (Maybe FilePath)
38 | Good Info
41data Info =
42 Info
43 { _pwd :: [String]
44 , _dirs :: [FilePath]
45 , _files :: [(FilePath, Bool)]
46 , _readme :: Maybe Text.Text
47 , _config :: Text.Text
48 }
52-- JSON
55goodToJson :: FilePath -> Info -> String
56goodToJson 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 ]
68encodeFilePath :: FilePath -> E.Value
69encodeFilePath filePath =
70 E.text (Text.pack filePath)
73encodeFile :: (FilePath, Bool) -> E.Value
74encodeFile (file, hasMain) =
75 E.array [ encodeFilePath file, E.bool hasMain ]
78badJson :: FilePath -> Maybe FilePath -> String
79badJson root potentialRoot =
80 Utf8.toString $ B.toLazyByteString $ E.encodeUgly $
81 E.object
82 [ ( "root", encodeFilePath root )
83 , ( "suggestion", maybe E.null encodeFilePath potentialRoot )
84 ]
88-- GENERATE HTML
91toHtml :: Project -> H.Html
92toHtml (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 ++ ");")
100 Bad suggestion ->
101 Help.makeHtml
102 (maybe "New Project!" (const "Existing Project?") suggestion)
103 ("/" ++ StaticFiles.elmPath)
104 ("Elm.Start.fullscreen(" ++ badJson root suggestion ++ ");")
108-- GET PROJECT
111getProject :: FilePath -> IO Project
112getProject 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)
120 True ->
121 do json <- Text.readFile "elm.json"
122 Good <$> getInfo json directory
125findNearestConfig :: [String] -> IO (Maybe FilePath)
126findNearestConfig dirs =
127 if null dirs then
128 return Nothing
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)
137moveToRoot :: IO ()
138moveToRoot =
139 do subDir <- Dir.getCurrentDirectory
140 maybeRoot <- findNearestConfig (splitDirectories subDir)
141 case maybeRoot of
142 Nothing ->
143 return ()
145 Just root ->
146 Dir.setCurrentDirectory root
150-- GET INFO
153getInfo :: Text.Text -> FilePath -> IO Info
154getInfo config directory =
155 do (dirs, files) <- getDirectoryInfo directory
156 readme <- getReadme directory
157 return $
158 Info
159 { _pwd = dropWhile ("." ==) (splitDirectories directory)
160 , _dirs = dirs
161 , _files = files
162 , _readme = readme
163 , _config = config
164 }
168-- README
171getReadme :: FilePath -> IO (Maybe Text.Text)
172getReadme dir =
173 do let readmePath = dir </> "README.md"
174 exists <- Dir.doesFileExist readmePath
175 if exists
176 then Just <$> Text.readFile readmePath
177 else return Nothing
181-- DIRECTORIES / FILES
184getDirectoryInfo :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
185getDirectoryInfo dir =
186 do contents <- Dir.getDirectoryContents dir
188 allDirs <- filterM (Dir.doesDirectoryExist . (dir </>)) contents
189 rawFiles <- filterM (Dir.doesFileExist . (dir </>)) contents
191 files <- mapM (inspectFile dir) rawFiles
193 return (allDirs, files)
196inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)
197inspectFile dir filePath =
198 if takeExtension filePath == ".elm" then
199 do source <- Text.readFile (dir </> filePath)
200 let hasMain = Text.isInfixOf "\nmain " source
201 return (filePath, hasMain)
203 else
204 return (filePath, False)