git.iko.soy/elk
on master help sign in
Get parts of reactor working / remove blaze dependency
c25388eEvan Czaplicki
builder/src/Reporting/Progress.hs+8
compare with master
unifiedsplit
@@ -2,6 +2,7 @@
2module Reporting.Progress
2module Reporting.Progress
3 ( Reporter(..)
3 ( Reporter(..)
4 , makeReporter
4 , makeReporter
5+ , silentReporter
5 , Msg(..)
6 , Msg(..)
6 , Progress(..)
7 , Progress(..)
7 , Outcome(..)
8 , Outcome(..)
@@ -43,6 +44,13 @@ makeReporter chan mvar =
43 Reporter tell end
44 Reporter tell end
44
45
45
46
47+silentReporter :: Reporter
48+silentReporter =
49+ Reporter
50+ (\_ -> return ())
51+ (\_ -> return ())
52+
53+
46
54
47-- MESSAGES
55-- MESSAGES
48
56
elm.cabal−3
@@ -54,7 +54,6 @@ Executable elm
54 other-modules:
54 other-modules:
55 Bump
55 Bump
56 Develop
56 Develop
57− Develop.Compile
58 Develop.Generate.Help
57 Develop.Generate.Help
59 Develop.Generate.Index
58 Develop.Generate.Index
60 Develop.StaticFiles
59 Develop.StaticFiles
@@ -229,8 +228,6 @@ Executable elm
229 ansi-wl-pprint >= 0.6.7 && < 0.7,
228 ansi-wl-pprint >= 0.6.7 && < 0.7,
230 base >=4.8 && <5,
229 base >=4.8 && <5,
231 binary >= 0.8 && < 0.9,
230 binary >= 0.8 && < 0.9,
232− blaze-html,
233− blaze-markup,
234 bytestring >= 0.9 && < 0.11,
231 bytestring >= 0.9 && < 0.11,
235 containers >= 0.5.8.2 && < 0.6,
232 containers >= 0.5.8.2 && < 0.6,
236 directory >= 1.2.3.0 && < 2.0,
233 directory >= 1.2.3.0 && < 2.0,
ui/terminal/src/Develop.hs+39−56
@@ -6,20 +6,18 @@ module Develop
6 where
6 where
7
7
8import Control.Applicative ((<|>))
8import Control.Applicative ((<|>))
9−import Control.Concurrent (threadDelay)
10import Control.Monad (guard)
9import Control.Monad (guard)
11import Control.Monad.Trans (MonadIO(liftIO))
10import Control.Monad.Trans (MonadIO(liftIO))
11+import qualified Data.ByteString.Builder as B
12+import qualified Data.ByteString as BS
12import qualified Data.HashMap.Strict as HashMap
13import qualified Data.HashMap.Strict as HashMap
13−import qualified Data.ByteString.Char8 as BSC
14+import Data.Monoid ((<>))
14−import System.Directory
15+import qualified System.Directory as Dir
15import System.FilePath
16import System.FilePath
16import Snap.Core
17import Snap.Core
17import Snap.Http.Server
18import Snap.Http.Server
18import Snap.Util.FileServe
19import Snap.Util.FileServe
19−import qualified Text.Blaze.Html5 as H
20−import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
21
20
22−import qualified Develop.Compile as Compile
23import qualified Develop.Generate.Help as Generate
21import qualified Develop.Generate.Help as Generate
24import qualified Develop.Generate.Index as Index
22import qualified Develop.Generate.Index as Index
25import qualified Develop.StaticFiles as StaticFiles
23import qualified Develop.StaticFiles as StaticFiles
@@ -41,13 +39,10 @@ run () (Flags maybePort) =
41 port =
39 port =
42 maybe 8000 id maybePort
40 maybe 8000 id maybePort
43 in
41 in
44− do putStrLn (startupMessage port)
42+ do putStrLn $ "Go to <http://localhost:" ++ show port ++ "> to see your project dashboard."
45
43
46 httpServe (config port) $
44 httpServe (config port) $
47 serveFiles
45 serveFiles
48− <|> route [ ("_compile", compile) ]
49− <|> route [ ("_elm/move-to-root", moveToRoot)]
50− <|> route [ ("_elm/create-new-project", createNewProject)]
51 <|> serveDirectoryWith directoryConfig "."
46 <|> serveDirectoryWith directoryConfig "."
52 <|> serveAssets
47 <|> serveAssets
53 <|> error404
48 <|> error404
@@ -68,21 +63,18 @@ config port =
68
63
69
64
70
65
71−-- HELPERS
66+-- INDEX
72−
73−
74−startupMessage :: Int -> String
75−startupMessage port =
76− "Go to <http://localhost:" ++ show port ++ "> to see your project dashboard."
77
67
78
68
79directoryConfig :: MonadSnap m => DirectoryConfig m
69directoryConfig :: MonadSnap m => DirectoryConfig m
80directoryConfig =
70directoryConfig =
81 let
71 let
82− customGenerator directory =
72+ customGenerator pwd =
83− do project <- liftIO (Index.getProject directory)
84− modifyResponse $ setContentType "text/html; charset=utf-8"
73+ do modifyResponse $ setContentType "text/html; charset=utf-8"
85− writeBuilder (Blaze.renderHtmlBuilder (Index.toHtml project))
74+ html <- liftIO $
75+ do root <- Dir.getCurrentDirectory
76+ Index.get root pwd
77+ writeBuilder html
86 in
78 in
87 fancyDirectoryConfig
79 fancyDirectoryConfig
88 { indexFiles = []
80 { indexFiles = []
@@ -90,38 +82,32 @@ directoryConfig =
90 }
82 }
91
83
92
84
93−compile :: Snap ()
94−compile =
95− do file <- getSafePath
96− guard =<< liftIO (doesFileExist file)
97− modifyResponse (setContentType "text/javascript")
98− writeBS =<< liftIO (Compile.toJavaScript file)
99
85
86+-- COMPILE
100
87
101−error404 :: Snap ()
88+
102−error404 =
89+_compile :: Snap ()
103− do modifyResponse $ setResponseStatus 404 "Not Found"
90+_compile =
91+ do file <- getSafePath
92+ guard =<< liftIO (Dir.doesFileExist file)
104− modifyResponse $ setContentType "text/html; charset=utf-8"
93+ modifyResponse (setContentType "text/javascript")
105− writeBuilder $ Blaze.renderHtmlBuilder $
94+ writeBS =<< liftIO (toJavaScript file)
106− Generate.makeHtml
107− "Page Not Found"
108− ("/" ++ StaticFiles.elmPath)
109− "Elm.NotFound.fullscreen();"
110
95
111
96
97+toJavaScript :: FilePath -> IO BS.ByteString
98+toJavaScript filePath =
99+ error "TODO toJavaScript" filePath
112
100
113−-- CREATE NEW PROJECT
114
101
115
102
116−createNewProject :: Snap ()
103+-- NOT FOUND
117−createNewProject =
118− do liftIO $ threadDelay (2 * 1000 * 1000)
119− return ()
120
104
121
105
122−moveToRoot :: Snap ()
106+error404 :: Snap ()
123−moveToRoot =
107+error404 =
124− liftIO Index.moveToRoot
108+ do modifyResponse $ setResponseStatus 404 "Not Found"
109+ modifyResponse $ setContentType "text/html; charset=utf-8"
110+ writeBuilder $ Generate.makePageHtml "NotFound" ""
125
111
126
112
127
113
@@ -131,16 +117,10 @@ moveToRoot =
131serveFiles :: Snap ()
117serveFiles :: Snap ()
132serveFiles =
118serveFiles =
133 do file <- getSafePath
119 do file <- getSafePath
134− guard =<< liftIO (doesFileExist file)
120+ guard =<< liftIO (Dir.doesFileExist file)
135 serveElm file <|> serveFilePretty file
121 serveElm file <|> serveFilePretty file
136
122
137
123
138−serveHtml :: MonadSnap m => H.Html -> m ()
139−serveHtml html =
140− do modifyResponse (setContentType "text/html")
141− writeBuilder (Blaze.renderHtmlBuilder html)
142−
143−
144
124
145-- SERVE FILES + CODE HIGHLIGHTING
125-- SERVE FILES + CODE HIGHLIGHTING
146
126
@@ -170,8 +150,10 @@ getSubExts fullExtension =
170
150
171serveCode :: String -> Snap ()
151serveCode :: String -> Snap ()
172serveCode file =
152serveCode file =
173− do code <- liftIO (readFile file)
153+ do code <- liftIO (BS.readFile file)
154+ modifyResponse (setContentType "text/html")
155+ writeBuilder $
174− serveHtml $ Generate.makeCodeHtml ('~' : '/' : file) code
156+ Generate.makeCodeHtml ('~' : '/' : file) (B.byteString code)
175
157
176
158
177
159
@@ -181,7 +163,8 @@ serveCode file =
181serveElm :: FilePath -> Snap ()
163serveElm :: FilePath -> Snap ()
182serveElm file =
164serveElm file =
183 do guard (takeExtension file == ".elm")
165 do guard (takeExtension file == ".elm")
184− serveHtml (Generate.makeElmHtml file)
166+ modifyResponse (setContentType "text/html")
167+ writeBuilder (error "TODO")
185
168
186
169
187
170
@@ -196,7 +179,7 @@ serveAssets =
196 pass
179 pass
197
180
198 Just (content, mimeType) ->
181 Just (content, mimeType) ->
199− do modifyResponse (setContentType $ BSC.pack (mimeType ++ ";charset=utf-8"))
182+ do modifyResponse (setContentType (mimeType <> ";charset=utf-8"))
200 writeBS content
183 writeBS content
201
184
202
185
@@ -204,7 +187,7 @@ serveAssets =
204-- MIME TYPES
187-- MIME TYPES
205
188
206
189
207−lookupMimeType :: FilePath -> Maybe BSC.ByteString
190+lookupMimeType :: FilePath -> Maybe BS.ByteString
208lookupMimeType ext =
191lookupMimeType ext =
209 HashMap.lookup ext mimeTypeDict
192 HashMap.lookup ext mimeTypeDict
210
193
@@ -214,7 +197,7 @@ lookupMimeType ext =
214 (a, b)
197 (a, b)
215
198
216
199
217−mimeTypeDict :: HashMap.HashMap FilePath BSC.ByteString
200+mimeTypeDict :: HashMap.HashMap FilePath BS.ByteString
218mimeTypeDict =
201mimeTypeDict =
219 HashMap.fromList
202 HashMap.fromList
220 [ ".asc" ==> "text/plain"
203 [ ".asc" ==> "text/plain"
ui/terminal/src/Develop/Compile.hsdeleted−30
@@ -1,30 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Develop.Compile
4− ( toJavaScript
5− )
6− where
7−
8−
9−import qualified Data.ByteString.Char8 as BS
10−
11−
12−
13−-- TO JAVASCRIPT
14−
15−
16−toJavaScript :: FilePath -> IO BS.ByteString
17−toJavaScript filePath =
18− do result <- error "TODO toJavaScript" filePath
19− case result of
20− Right (code, name) ->
21− return $ BS.append code $ BS.pack $
22− "var runElmProgram = Elm." ++ name ++ ".fullscreen;"
23−
24− Left errMsg ->
25− return $ BS.concat $
26− [ BS.pack $ "function runElmProgram() {\n\tElm.Errors.fullscreen("
27− , error "TODO show compile issues" errMsg
28− , ");\n}"
29− ]
30−
ui/terminal/src/Develop/Generate/Help.hs+42−92
@@ -1,113 +1,63 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE QuasiQuotes #-}
3module Develop.Generate.Help
4module Develop.Generate.Help
4− ( makeHtml
5+ ( makePageHtml
5 , makeCodeHtml
6 , makeCodeHtml
6− , makeElmHtml
7 )
7 )
8 where
8 where
9
9
10−import Text.Blaze.Html5 ((!))
11−import qualified Text.Blaze.Html5 as H
12−import qualified Text.Blaze.Html5.Attributes as A
13
10
14−import qualified Develop.StaticFiles as StaticFiles
11+import qualified Data.ByteString.Builder as B
12+import Data.Monoid ((<>))
13+import Text.RawString.QQ (r)
15
14
15+import qualified Elm.Name as N
16
16
17
17
18-- PAGES
18-- PAGES
19
19
20
20
21−makeHtml :: String -> String -> String -> H.Html
21+makePageHtml :: N.Name -> B.Builder -> B.Builder
22−makeHtml title jsFile initCode =
22+makePageHtml moduleName flags =
23− H.docTypeHtml $ do
23+ [r|<!DOCTYPE HTML>
24+<html>
24− H.head $ do
25+<head>
25− H.meta ! A.charset "UTF-8"
26+ <meta charset="UTF-8">
26− H.title $ H.toHtml title
27− H.link
28− ! A.type_ "text/css"
29− ! A.rel "stylesheet"
27+ <link type="text/css" rel="stylesheet" href="/_elm/styles.css">
30− ! A.href (H.toValue ("/" ++ StaticFiles.cssPath))
28+ <script src="/_elm/elm.js"></script>
31− H.script ! A.src (H.toValue jsFile) $ ""
29+</head>
32−
30+<body>
33− H.body $ do
31+<script>
34− H.script $ H.preEscapedToMarkup initCode
32+Elm.|] <> N.toBuilder moduleName <> [r|.fullscreen(|] <> flags <> [r|);
33+</script>
34+</body>
35+</html>
36+|]
35
37
36
38
37
39
38-- CODE
40-- CODE
39
41
40
42
41−makeCodeHtml :: String -> String -> H.Html
43+makeCodeHtml :: FilePath -> B.Builder -> B.Builder
42makeCodeHtml title code =
44makeCodeHtml title code =
43− H.docTypeHtml $ do
45+ [r|<!DOCTYPE HTML>
46+<html>
44− H.head $ do
47+<head>
45− H.meta ! A.charset "UTF-8"
48+ <meta charset="UTF-8">
46− H.title $ H.toHtml title
49+ <title>|] <> B.stringUtf8 title <> [r|</title>
47− H.style ! A.type_ "text/css" $ codeStyle
50+ <style type="text/css">
48−
51+ @import url(/_elm/source-code-pro.ttf);
52+ html, head, body, pre { margin: 0; height: 100%; }
53+ body { font-family: "Source Code Pro", monospace; }
54+ </style>
49− H.link ! A.rel "stylesheet" ! A.href "//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/styles/default.min.css"
55+ <link type="text/css" rel="stylesheet" href="//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/styles/default.min.css">
50− H.script ! A.src "//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/highlight.min.js" $ ""
56+ <script src="//cdnjs.cloudflare.com/ajax/libs/highlight.js/9.3.0/highlight.min.js"></script>
51− H.script $ "if (hljs) { hljs.initHighlightingOnLoad(); }"
57+ <script>if (hljs) { hljs.initHighlightingOnLoad(); }</script>
52−
58+</head>
53− H.body ! A.style "background-color: #F0F0F0;" $ do
59+<body style="background-color: #F0F0F0;">
54− H.pre $ H.code $ H.toHtml code
60+<pre><code>|] <> code <> [r|</code></pre>
55−
56−
57−codeStyle :: H.Html
58−codeStyle =
59− H.toHtml $ unlines $
60− [ "html, head, body, pre {"
61− , " margin: 0;"
62− , " height: 100%;"
63− , "}"
64− , "body {"
61+</body>
65− , " font-family: 'Source Code Pro', monospace;"
66− , "}"
67− ]
68−
69−
70−
71−-- ELM CODE
72−
73−
74−makeElmHtml :: FilePath -> H.Html
75−makeElmHtml filePath =
76− H.docTypeHtml $ do
77− H.head $ do
78− H.meta ! A.charset "UTF-8"
79− H.title $ H.toHtml ("~/" ++ filePath)
80− H.style ! A.type_ "text/css" $ elmStyle
81−
82− H.body $ do
83− H.div ! A.style waitingStyle $ do
84− H.div ! A.style "font-size: 3em;" $ "Building your project!"
85− H.img ! A.src (H.toValue StaticFiles.waitingPath)
86− H.div ! A.style "font-size: 1em" $ "With new projects, I need a bunch of extra time to download packages."
87−
88− H.script ! A.src (H.toValue ("/_compile/" ++ filePath)) ! A.charset "utf-8" $ ""
89− H.script $ H.preEscapedToMarkup $ unlines $
90− [ "while (document.body.firstChild) {"
91− , " document.body.removeChild(document.body.firstChild);"
92− , "}"
93− , "runElmProgram();"
94− ]
95−
96−
97−elmStyle :: H.Html
98−elmStyle =
99− H.toHtml $ unlines $
100− [ "@import url(http://fonts.googleapis.com/css?family=Source+Sans+Pro);"
101− , "html, head, body {"
62+</html>
102− , " margin: 0;"
103− , " height: 100%;"
104− , "}"
105− ]
63+|]
106−
107−
108−waitingStyle :: H.AttributeValue
109−waitingStyle =
110− H.stringValue $
111− "width: 100%; height: 100%; display: flex; flex-direction: column;"
112− ++ " justify-content: center; align-items: center; color: #9A9A9A;"
113− ++ " font-family: 'Source Sans Pro';"
ui/terminal/src/Develop/Generate/Index.hs+63−133
@@ -1,50 +1,52 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Develop.Generate.Index
3module Develop.Generate.Index
4− ( toHtml
4+ ( get
5− , getProject
6− , moveToRoot
7 )
5 )
8 where
6 where
9
7
8+
10import Control.Monad (filterM)
9import Control.Monad (filterM)
11import qualified Data.ByteString.Builder as B
10import qualified Data.ByteString.Builder as B
12−import qualified Data.ByteString.Lazy.UTF8 as Utf8
11+import qualified Data.Map as Map
13−import qualified Data.List as List
14import qualified Data.Text as Text
12import qualified Data.Text as Text
15import qualified Data.Text.IO as Text
13import qualified Data.Text.IO as Text
16import qualified System.Directory as Dir
14import qualified System.Directory as Dir
17−import System.FilePath ((</>), joinPath, splitDirectories, takeExtension)
15+import System.FilePath ((</>), splitDirectories, takeExtension)
18−import qualified Text.Blaze.Html5 as H
19
16
20import qualified Develop.Generate.Help as Help
17import 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
22import qualified Json.Encode as E
21import 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
23
25
24
26
25
27
26−-- PROJECT
28+-- GET
27
29
28
30
29−data Project =
31+get :: FilePath -> FilePath -> IO B.Builder
30− Project
32+get root pwd =
31− { _root :: FilePath
33+ do flags <- getFlags root pwd
32− , _info :: PerhapsInfo
34+ return $ Help.makePageHtml "Index" (E.encode (encode flags))
33− }
34
35
35
36
36−data PerhapsInfo
37− = Bad (Maybe FilePath)
38− | Good Info
39
37
38+-- FLAGS
40
39
40+
41−data Info =
41+data Flags =
42− Info
42+ Flags
43+ { _root :: FilePath
43− { _pwd :: [String]
44+ , _pwd :: [String]
44 , _dirs :: [FilePath]
45 , _dirs :: [FilePath]
45 , _files :: [(FilePath, Bool)]
46 , _files :: [(FilePath, Bool)]
46 , _readme :: Maybe Text.Text
47 , _readme :: Maybe Text.Text
47− , _config :: Text.Text
48+ , _project :: Maybe Project.Project
49+ , _exactDeps :: Map.Map Pkg.Name Pkg.Version
48 }
50 }
49
51
50
52
@@ -52,17 +54,17 @@ data Info =
52-- JSON
54-- JSON
53
55
54
56
55−goodToJson :: FilePath -> Info -> String
57+encode :: Flags -> E.Value
56−goodToJson root (Info pwd dirs files readme config) =
58+encode (Flags root pwd dirs files readme project exactDeps) =
57− Utf8.toString $ B.toLazyByteString $ E.encodeUgly $
58− E.object
59+ E.object
59− [ ( "root", encodeFilePath root )
60+ [ ( "root", encodeFilePath root )
60− , ( "pwd", E.list encodeFilePath pwd )
61+ , ( "pwd", E.list encodeFilePath pwd )
61− , ( "dirs", E.list encodeFilePath dirs )
62+ , ( "dirs", E.list encodeFilePath dirs )
62− , ( "files", E.list encodeFile files )
63+ , ( "files", E.list encodeFile files )
63− , ( "readme", maybe E.null E.text readme )
64+ , ( "readme", maybe E.null E.text readme )
64− , ( "config", E.text config )
65+ , ( "project", maybe E.null Project.encode project )
66+ , ( "exactDeps", E.dict Pkg.toText Pkg.encodeVersion exactDeps)
65− ]
67+ ]
66
68
67
69
68encodeFilePath :: FilePath -> E.Value
70encodeFilePath :: FilePath -> E.Value
@@ -72,102 +74,37 @@ encodeFilePath filePath =
72
74
73encodeFile :: (FilePath, Bool) -> E.Value
75encodeFile :: (FilePath, Bool) -> E.Value
74encodeFile (file, hasMain) =
76encodeFile (file, hasMain) =
77+ E.object
75− E.array [ encodeFilePath file, E.bool hasMain ]
78+ [ ("name", encodeFilePath file)
76−
79+ , ("runnable", E.bool hasMain)
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− ]
80+ ]
85−
86−
87
81
88−-- GENERATE HTML
89
82
90
83
91−toHtml :: Project -> H.Html
84+-- GET FLAGS
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 ++ ");")
99
85
100− Bad suggestion ->
101− Help.makeHtml
102− (maybe "New Project!" (const "Existing Project?") suggestion)
103− ("/" ++ StaticFiles.elmPath)
104− ("Elm.Start.fullscreen(" ++ badJson root suggestion ++ ");")
105
86
87+getFlags :: FilePath -> FilePath -> IO Flags
88+getFlags root pwd =
89+ do (dirs, files) <- getDirsAndFiles pwd
90+ readme <- getReadme pwd
106
91
92+ maybeSummary <-
93+ Task.run Progress.silentReporter $
94+ Verify.verify root =<< Project.read "elm.json"
107
95
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
157 return $
96 return $
158− Info
97+ Flags
98+ { _root = root
159− { _pwd = dropWhile ("." ==) (splitDirectories directory)
99+ , _pwd = dropWhile ("." ==) (splitDirectories pwd)
160 , _dirs = dirs
100 , _dirs = dirs
161 , _files = files
101 , _files = files
162 , _readme = readme
102 , _readme = readme
163− , _config = config
103+ , _project = fmap Summary._project maybeSummary
104+ , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary
164 }
105 }
165
106
166
107
167−
168−-- README
169−
170−
171getReadme :: FilePath -> IO (Maybe Text.Text)
108getReadme :: FilePath -> IO (Maybe Text.Text)
172getReadme dir =
109getReadme dir =
173 do let readmePath = dir </> "README.md"
110 do let readmePath = dir </> "README.md"
@@ -177,28 +114,21 @@ getReadme dir =
177 else return Nothing
114 else return Nothing
178
115
179
116
180−
181−-- DIRECTORIES / FILES
182−
183−
184−getDirectoryInfo :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
117+getDirsAndFiles :: FilePath -> IO ([FilePath], [(FilePath, Bool)])
185−getDirectoryInfo dir =
118+getDirsAndFiles pwd =
186− do contents <- Dir.getDirectoryContents dir
119+ do contents <- Dir.getDirectoryContents pwd
187−
188− allDirs <- filterM (Dir.doesDirectoryExist . (dir </>)) contents
120+ dirs <- filterM (Dir.doesDirectoryExist . (pwd </>)) contents
189− rawFiles <- filterM (Dir.doesFileExist . (dir </>)) contents
121+ filePaths <- filterM (Dir.doesFileExist . (pwd </>)) contents
190−
191− files <- mapM (inspectFile dir) rawFiles
122+ files <- mapM (inspectFile pwd) filePaths
192−
193− return (allDirs, files)
123+ return (dirs, files)
194
124
195
125
196inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)
126inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)
197−inspectFile dir filePath =
127+inspectFile pwd path =
198− if takeExtension filePath == ".elm" then
128+ if takeExtension path == ".elm" then
199− do source <- Text.readFile (dir </> filePath)
129+ do source <- Text.readFile (pwd </> path)
200 let hasMain = Text.isInfixOf "\nmain " source
130 let hasMain = Text.isInfixOf "\nmain " source
201− return (filePath, hasMain)
131+ return (path, hasMain)
202
132
203 else
133 else
204− return (filePath, False)
134+ return (path, False)
ui/terminal/src/Develop/StaticFiles.hs+2−1
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
3module Develop.StaticFiles
4module Develop.StaticFiles
4 ( lookup
5 ( lookup
@@ -22,7 +23,7 @@ import qualified Develop.StaticFiles.Build as Build
22
23
23
24
24type MimeType =
25type MimeType =
25− String
26+ BS.ByteString
26
27
27
28
28lookup :: FilePath -> Maybe (BS.ByteString, MimeType)
29lookup :: FilePath -> Maybe (BS.ByteString, MimeType)