Integrating elm-reactor-index

Added Index.elm and Util.elm to frontend. Added necessary asset files (icons). Fixed asset and source paths in Index.elm. Changed Index.hs to serve the new index page. Added compile hooks for Index.elm Added assets to staticAssets in Main.hs. Added index.js to staticAssets in Main.hs. Added assets to .cabal file. Added index.js to .cabal file. Build succeeds. Build is tested. Works as expected. (as far as I can tell)
elm-lang · Jul 20, 2015 · dc7c268 · dc7c268
1 parent 6d97dbf
commit dc7c268
Show file tree

Hide file tree

Showing 26 changed files with 145 additions and 35 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,5 +1,6 @@
 dist
 assets/_reactor/debug.js
+assets/_reactor/index.js
 elm-stuff
 cabal.sandbox.config
 .cabal-sandbox/
diff --git a/Setup.hs b/Setup.hs
@@ -11,6 +11,38 @@ import System.FilePath
 import System.Directory
 
 
+debugScriptPath :: FilePath
+debugScriptPath = outputPath "debug.js"
+
+
+indexScriptPath :: FilePath
+indexScriptPath = outputPath "index.js"
+
+
+toBuild :: [IO ()]
+toBuild =
+  [ buildSideBar
+  , buildIndex
+  ]
+
+
+outputPath :: FilePath -> FilePath
+outputPath = (("assets" </> "_reactor") </>)
+
+
+elmCompile :: FilePath -> FilePath -> IO ()
+elmCompile source target = do
+  (exitCode, out, err) <- readProcessWithExitCode
+                            "elm-make"
+                            [ "--yes", "frontend" </> source, "--output=" ++ target ]
+                            ""
+  case exitCode of
+    ExitSuccess -> return ()
+    ExitFailure _ ->
+      hPutStrLn stderr (unlines ["Failed to build" ++ source, "", out, err]) >>
+      exitFailure
+
+
 main :: IO ()
 main =
   defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }
@@ -19,25 +51,15 @@ main =
 myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
 myPostBuild args flags pd lbi =
   do  putStrLn "Custom build step: creating and collecting all static resources"
-      buildSideBar
+      sequence_ toBuild
       src <- readFile ("frontend" </> "debugger-implementation.js")
-      appendFile output src
+      appendFile debugScriptPath src
       postBuild simpleUserHooks args flags pd lbi
 
 
-output :: FilePath
-output =
-  "assets" </> "_reactor" </> "debug.js"
+buildSideBar :: IO ()
+buildSideBar = elmCompile "SideBar.elm" debugScriptPath
 
 
-buildSideBar :: IO ()
-buildSideBar =
-  do  (exitCode, out, err) <-
-        readProcessWithExitCode "elm-make" [ "--yes", "frontend" </> "SideBar.elm", "--output=" ++ output ] ""
-      case exitCode of
-        ExitSuccess ->
-          return ()
-
-        ExitFailure _ ->
-          do  hPutStrLn stderr ("Failed to build SideBar.elm\n\n" ++ out ++ err)
-              exitFailure
+buildIndex :: IO ()
+buildIndex = elmCompile "Index.elm" indexScriptPath
diff --git a/assets/_reactor/icons/aperture-4x.png b/assets/_reactor/icons/aperture-4x.png
diff --git a/assets/_reactor/icons/audio-4x.png b/assets/_reactor/icons/audio-4x.png
diff --git a/assets/_reactor/icons/book-4x.png b/assets/_reactor/icons/book-4x.png
diff --git a/assets/_reactor/icons/browser-4x.png b/assets/_reactor/icons/browser-4x.png
diff --git a/assets/_reactor/icons/code-4x.png b/assets/_reactor/icons/code-4x.png
diff --git a/assets/_reactor/icons/cog-4x.png b/assets/_reactor/icons/cog-4x.png
diff --git a/assets/_reactor/icons/document-4x.png b/assets/_reactor/icons/document-4x.png
diff --git a/assets/_reactor/icons/file-4x.png b/assets/_reactor/icons/file-4x.png
diff --git a/assets/_reactor/icons/folder-4x.png b/assets/_reactor/icons/folder-4x.png
diff --git a/assets/_reactor/icons/hard-drive-4x.png b/assets/_reactor/icons/hard-drive-4x.png
diff --git a/assets/_reactor/icons/home-4x.png b/assets/_reactor/icons/home-4x.png
diff --git a/assets/_reactor/icons/key-4x.png b/assets/_reactor/icons/key-4x.png
diff --git a/assets/_reactor/icons/list-4x.png b/assets/_reactor/icons/list-4x.png
diff --git a/assets/_reactor/icons/lock-locked-4x.png b/assets/_reactor/icons/lock-locked-4x.png
diff --git a/assets/_reactor/icons/spreadsheet-4x.png b/assets/_reactor/icons/spreadsheet-4x.png
diff --git a/assets/_reactor/icons/terminal-4x.png b/assets/_reactor/icons/terminal-4x.png
diff --git a/assets/_reactor/icons/wrench-4x.png b/assets/_reactor/icons/wrench-4x.png
diff --git a/assets/_reactor/wrench.png b/assets/_reactor/wrench.png
diff --git a/backend/Index.hs b/backend/Index.hs
@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LBS
 import           Data.List                  (intercalate)
 import           Data.Aeson as Json
 import qualified Data.Map as Map
-import           Data.FileEmbed             (embedFile)
 import           System.Directory           (doesDirectoryExist, doesFileExist,
                                             getDirectoryContents)
 import           System.FilePath            ((</>), splitDirectories)
@@ -24,6 +23,10 @@ elmConfig :: FilePath
 elmConfig = "elm-package.json"
 
 
+compiledCodeLocation :: S.ByteString
+compiledCodeLocation = "/_reactor/index.js"
+
+
 {-|
   Haskell representation fof the Model record as used by the frontend.
 -}
@@ -122,13 +125,12 @@ indexPageTemplate :: S.ByteString -> S.ByteString -> S.ByteString
 indexPageTemplate directory projectData = S.intercalate ""
   [ "<head><title>"
   , directory
-  , "</title><script charset=\"utf-8\">"
-  , $(embedFile "embedded/elm.js")
-  , "</script><script type=\"text/javascript\">"
+  , "</title><script charset=\"utf-8\" src=\""
+  , compiledCodeLocation
+  , "\"></script><script type=\"text/javascript\">"
   , projectData
-  , "</script><style type=\"text/css\">"
-  , $(embedFile "embedded/index.css")
-  , "</style></head><body><script type=\"text/javascript\">\
+  , "</script><style>html, body {margin: 0;padding: 0;}</style>\
+    \</head><body><script type=\"text/javascript\">\
     \window.addEventListener(\"DOMContentLoaded\", function (){ \
     \Elm.fullscreen(Elm.Index, { modelPort: document.initialModel });})\
     \</script></body>\n"
@@ -159,7 +161,7 @@ elmIndexGenerator directory = do
   allFiles <- liftIO $ filterM (doesFileExist . (directory </>)) entries
   configExists <- liftIO $ doesFileExist $ "." </> elmConfig
   config <- if configExists
-    then decodeStrict <$> (liftIO $ S.readFile $ "." </> elmConfig)
+    then decodeStrict <$> liftIO (S.readFile $ "." </> elmConfig)
     else return Nothing
 
   let model =

diff --git a/backend/Main.hs b/backend/Main.hs
@@ -138,19 +138,37 @@ serveHtml html =
 serveAssets :: Snap ()
 serveAssets =
   do  file <- BSC.unpack . rqPathInfo <$> getRequest
-      case file `elem` staticAssets of
-        True ->
-          serveFile =<< liftIO (Utils.getDataFile file)
+      if file `elem` staticAssets
+        then serveFile =<< liftIO (Utils.getDataFile file)
+        else pass
 
-        False ->
-          pass
+
+icon :: String -> FilePath
+icon name = "_reactor/icons" </> name ++ "-4x.png"
 
 
 staticAssets :: [FilePath]
 staticAssets =
     [ "favicon.ico"
     , "_reactor/debug.js"
-    , "_reactor/wrench.png"
+    , "_reactor/index.js"
+    , icon "file"
+    , icon "folder"
+    , icon "book"
+    , icon "home"
+    , icon "browser"
+    , icon "aperture"
+    , icon "code"
+    , icon "cog"
+    , icon "wrench"
+    , icon "document"
+    , icon "spreadsheet"
+    , icon "key"
+    , icon "lock-locked"
+    , icon "audio"
+    , icon "list"
+    , icon "hard-drive"
+    , icon "terminal"
     , "_reactor/debugger/pause-button-up.png"
     , "_reactor/debugger/pause-button-down.png"
     , "_reactor/debugger/pause-button-hover.png"
@@ -161,4 +179,3 @@ staticAssets =
     , "_reactor/debugger/restart-button-down.png"
     , "_reactor/debugger/restart-button-hover.png"
     ]
-
diff --git a/elm-package.json b/elm-package.json
@@ -14,4 +14,4 @@
         "evancz/elm-markdown": "1.1.4 <= v < 2.0.0"
     },
     "elm-version": "0.15.0 <= v < 0.16.0"
-}
+}
diff --git a/elm-reactor.cabal b/elm-reactor.cabal
@@ -33,7 +33,24 @@ Data-dir:
 Data-files:
   favicon.ico
   _reactor/debug.js
-  _reactor/wrench.png
+  _reactor/index.js
+  _reactor/icons/file-4x.png
+  _reactor/icons/folder-4x.png
+  _reactor/icons/book-4x.png
+  _reactor/icons/home-4x.png
+  _reactor/icons/browser-4x.png
+  _reactor/icons/aperture-4x.png
+  _reactor/icons/code-4x.png
+  _reactor/icons/cog-4x.png
+  _reactor/icons/wrench-4x.png
+  _reactor/icons/document-4x.png
+  _reactor/icons/spreadsheet-4x.png
+  _reactor/icons/key-4x.png
+  _reactor/icons/lock-locked-4x.png
+  _reactor/icons/audio-4x.png
+  _reactor/icons/list-4x.png
+  _reactor/icons/hard-drive-4x.png
+  _reactor/icons/terminal-4x.png
   _reactor/debugger/pause-button-up.png
   _reactor/debugger/pause-button-down.png
   _reactor/debugger/pause-button-hover.png

diff --git a/frontend/Index.elm b/frontend/Index.elm
@@ -7,14 +7,13 @@ import Signal exposing (Signal, Address)
 import String
 import Util exposing (..)
 import Dict exposing (fromList)
-import Maybe.Extra exposing (or)
 
 
 -- CONSTANTS
 
 (=>) = (,)
 
-iconPath = "open-iconic/png"
+iconPath = "/_reactor/icons"
 separatorStyle = style [ "display" => "inline-block", "margin" => "0 5px" ]
 guiDependencySeparator = span [ separatorStyle ] [ text "/" ]
 guiPathSeparator = span [ separatorStyle ] [ text "/" ]
@@ -130,6 +129,13 @@ clearfix =
 -- UTILITY FUNCTIONS
 
 
+or : Maybe a -> Maybe a -> Maybe a
+or ma mb =
+  case ma of
+    Nothing -> mb
+    _ -> ma
+
+
 packageUrl : Dependency -> String
 packageUrl {account, name, version} =
   "http://package.elm-lang.org/packages"

diff --git a/frontend/Util.elm b/frontend/Util.elm
@@ -0,0 +1,45 @@
+module Util where
+
+
+import String
+
+
+isSuffixOf = String.endsWith
+
+
+(</>) : String -> String -> String
+a </> b =
+  if "/" `isSuffixOf` a
+    then a ++ b
+    else a ++ "/" ++ b
+
+
+splitPath = String.split "/"
+
+
+find : a -> List (a, b) -> Maybe b
+find elem l =
+  case l of
+    [] -> Nothing
+    (elem2, val)::tail ->
+      if elem2 == elem
+        then Just val
+        else find elem tail
+
+
+takeExtension : String -> String
+takeExtension str =
+  let
+    loop l =
+      case l of
+        [] -> ""
+        [a] -> a
+        (_::t) -> loop t
+  in
+    case String.split "." str of
+      [] -> ""
+      (_::t) -> loop t
+
+
+(><) : List a -> List b -> List (a,b)
+(><) = List.map2 (,)
-Original file line number
+Diff line change
@@ Expand Up / @@ -14,4 +14,4 @@ @@
             "evancz/elm-markdown": "1.1.4 <= v < 2.0.0"
         },
         "elm-version": "0.15.0 <= v < 0.16.0"
-    }
+    }