Add feature: "add css links" #138

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

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) ++ ");")
+    []
 
 
 

src/backend/Generate/NotFound.hs

@@ -12,3 +12,4 @@ html =
     "Page Not Found"
     ("/" ++ StaticFiles.notFoundPath)
     "Elm.NotFound.fullscreen();"
+    []

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 <https://github.com/elm-lang/elm-reactor>."
@@ -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)