diff --git a/src/backend/Generate/Help.hs b/src/backend/Generate/Help.hs index af6a868..65ec687 100644 --- a/src/backend/Generate/Help.hs +++ b/src/backend/Generate/Help.hs @@ -5,14 +5,13 @@ module Generate.Help (makeHtml, makeCodeHtml, makeElmHtml) where import Text.Blaze.Html5 ((!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A - - +import Data.String (fromString) -- PAGES -makeHtml :: String -> String -> String -> H.Html -makeHtml title jsFile initCode = +makeHtml :: String -> String -> String -> [String] -> H.Html +makeHtml title jsFile initCode cssIncludes = H.docTypeHtml $ do H.head $ do H.meta ! A.charset "UTF-8" @@ -22,11 +21,12 @@ makeHtml title jsFile initCode = H.body $ do H.script $ H.preEscapedToMarkup initCode - H.link - ! A.type_ "text/css" - ! A.rel "stylesheet" - ! A.href "https://fonts.googleapis.com/css?family=Source+Sans+Pro|Source+Code+Pro" - + link' "https://fonts.googleapis.com/css?family=Source+Sans+Pro|Source+Code+Pro" + mapM_ link' cssIncludes + where link' css = H.link + ! A.type_ "text/css" + ! A.rel "stylesheet" + ! A.href (fromString css) normalStyle :: H.Html normalStyle = @@ -82,13 +82,14 @@ codeStyle = -- ELM CODE -makeElmHtml :: FilePath -> H.Html -makeElmHtml filePath = +makeElmHtml :: FilePath -> [String] -> H.Html +makeElmHtml filePath cssIncludes = H.docTypeHtml $ do H.head $ do H.meta ! A.charset "UTF-8" H.title $ H.toHtml ("~/" ++ filePath) H.style ! A.type_ "text/css" $ elmStyle + mapM_ link' cssIncludes H.body $ do H.div ! A.style waitingStyle $ do @@ -103,6 +104,10 @@ makeElmHtml filePath = , "}" , "runElmProgram();" ] + where link' css = H.link + ! A.type_ "text/css" + ! A.rel "stylesheet" + ! A.href (fromString css) elmStyle :: H.Html diff --git a/src/backend/Generate/Index.hs b/src/backend/Generate/Index.hs index 56115a6..ad44118 100644 --- a/src/backend/Generate/Index.hs +++ b/src/backend/Generate/Index.hs @@ -75,9 +75,10 @@ instance ToJSON PackageInfo where toHtml :: Info -> H.Html toHtml info@(Info pwd _ _ _ _) = Help.makeHtml - (List.intercalate "/" ("~" : pwd)) + (List.intercalate "/" ("~" : pwd)) ("/" ++ StaticFiles.indexPath) ("Elm.Index.fullscreen(" ++ BSU8.toString (Json.encode info) ++ ");") + [] diff --git a/src/backend/Generate/NotFound.hs b/src/backend/Generate/NotFound.hs index e3564c1..9ecf1d1 100644 --- a/src/backend/Generate/NotFound.hs +++ b/src/backend/Generate/NotFound.hs @@ -12,3 +12,4 @@ html = "Page Not Found" ("/" ++ StaticFiles.notFoundPath) "Elm.NotFound.fullscreen();" + [] diff --git a/src/backend/Main.hs b/src/backend/Main.hs index 5e2ada6..692243c 100644 --- a/src/backend/Main.hs +++ b/src/backend/Main.hs @@ -37,6 +37,7 @@ import Elm.Utils ((|>)) data Flags = Flags { address :: String , port :: Int + , cssIncludes :: [String] } deriving (Data,Typeable,Show,Eq) @@ -50,6 +51,9 @@ flags = Flags , port = 8000 &= help "set the port of the reactor (default: 8000)" + , cssIncludes = [] + &= help "list of urls to css files (default: [])" + } &= help "Interactive development tool that makes it easy to develop and debug Elm programs.\n\ \ Read more about it at ." @@ -86,7 +90,7 @@ main = putStrLn startupMessage httpServe (config (BSC.pack (address cargs)) (port cargs)) $ - serveFiles + serveFiles (cssIncludes cargs) <|> route [ ("_compile", compile) ] <|> route [ ("_changes", socket) ] <|> serveDirectoryWith directoryConfig "." @@ -143,11 +147,11 @@ error404 = -- SERVE FILES -serveFiles :: Snap () -serveFiles = +serveFiles :: [String] -> Snap () +serveFiles cssLinks = do file <- getSafePath guard =<< liftIO (doesFileExist file) - serveElm file <|> serveFilePretty file + serveElm file cssLinks <|> serveFilePretty file serveHtml :: MonadSnap m => H.Html -> m () @@ -185,18 +189,18 @@ getSubExts fullExtension = serveCode :: String -> Snap () serveCode file = - do code <- liftIO (readFile file) - serveHtml $ Generate.makeCodeHtml ('~' : '/' : file) code + do code <- liftIO (readFile file) + serveHtml $ Generate.makeCodeHtml ('~' : '/' : file) code -- SERVE ELM -serveElm :: FilePath -> Snap () -serveElm file = - do guard (takeExtension file == ".elm") - serveHtml (Generate.makeElmHtml file) +serveElm :: FilePath -> [String] -> Snap () +serveElm file cssLinks = + do guard (takeExtension file == ".elm") + serveHtml (Generate.makeElmHtml file cssLinks)