Merge pull request #16 from srid/static-assets

Support for static assets

.ghcid

@@ -1 +1 @@
---warnings -T Ema.Example.Ex02_Clock.main
+--warnings -T Ema.Example.Ex03_Documentation.main --setup ":set args -C ./docs"

.github/workflows/publish.yaml

@@ -18,7 +18,7 @@ jobs:
       - name: Build and generate docs HTML 🔧
         run: |
           mkdir ./docs-output
-          nix run . -- gen ./docs-output
+          nix run . -- -C ./docs gen $(pwd)/docs-output
       - name: Deploy to gh-pages 🚀
         uses: peaceiris/actions-gh-pages@v3
         with:

README.md

@@ -1,6 +1,6 @@
 # ema
 
-<img width="10%" src="./ema.svg">
+<img width="10%" src="./docs/ema.svg">
 
 Ema is a next-gen **Haskell** library for building [jamstack-style](https://jamstack.org/) static sites, with fast hot reload. See [ema.srid.ca](https://ema.srid.ca/) for documentation.
 
@@ -16,17 +16,16 @@ main = do
 
 ## Quick Preview
 
-If you have Nix installed with Flakes, give Ema a test-drive by running it to serve its own documentation:
+If you have Nix installed, give Ema a test-drive by running it to serve its own documentation:
 
 ```bash
-PORT=8000 nix run github:srid/ema
+git clone https://github.com/srid/ema.git 
+cd ema && PORT=8000 nix run . -- -C ./docs
 ```
 
-NOTE: This will work if you have this repo's `./docs` directory locally. In future, ema should be made to include the docs in the nix derivation and reference it.
-
 ## Hacking
 
-Run `bin/run` (or <kbd>Ctrl+Shift+B</kbd> in VSCode). This runs the clock example; modify `./.ghcid` to run a different example.
+Run `bin/run` (or <kbd>Ctrl+Shift+B</kbd> in VSCode). This runs the documentation example; modify `./.ghcid` to run a different example.
 
 ## TODO
 
@@ -46,7 +45,7 @@ pre-announce,
   - [x] opts
   - [ ] logging
 - [x] [deal with errors](https://github.com/srid/memoir/issues/1)
-- [ ] How to serve non-generated files (css, img, etc.)
+- [x] How to serve non-generated files (css, img, etc.)
 - [ ] Publish Data.LVar to Hackage
 - [ ] documentation ([guide](https://documentation.divio.com/))
   - [x] Avoid tailwind CDN in docs (use twind or windicss) for better lighthouse score

docs/concepts.md

@@ -3,4 +3,5 @@
 * [Hot Reload](concepts/hot-reload.md)
 * [LVar](concepts/lvar.md)
 * [Slug](concepts/slug.md)
+* [CLI](concepts/cli.md)
 * [Haskell's Safety](concepts/haskell-safety.md)

docs/concepts/cli.md

@@ -0,0 +1,6 @@
+# CLI
+
+TODO
+
+- -C to change directory
+- gen to generate

docs/guide/filesystem.md

@@ -4,3 +4,6 @@ TODO
 
 - fsnotify
   - link to hot-reload
+- eg: .markdown
+- or even .json files for some metadata
+- even for HTML templates

docs/guide/render.md

@@ -33,7 +33,7 @@ render model route = Blaze.renderHtml $
 
 Note that Ema provides a `routeUrl` helper function that serializes your route to the final URL (here, `/about`) for linking to.
 
-Spend a few moments to recognize how this is *much simpler* to write than dealing with HTML template files spread across the disk. Besides, [Haskell's type-safety](/concepts/haskell-safety.md) now applies to your HTML as well. On top of it, Ema's [hot reload](/concepts/hot-reload.md) will instantly update the dev server's browser view whenever you change your HTML (or any of the Haskell source code).
+Spend a few moments to recognize how this is *much simpler* to write than dealing with HTML template files spread across the disk as is the case with traditional static site generators. Of course when using Ema nothing prevents you from choosing to use traditional HTML templates (see [working with files](guide/filesystem.md) for tips on that). But if you choose instead to go the DSL route, [Haskell's type-safety](/concepts/haskell-safety.md) now applies to your HTML as well. On top of it, Ema's [hot reload](/concepts/hot-reload.md) will instantly update the dev server's browser view whenever you change your HTML (or any of the Haskell source code).
 
 
 {.last}

docs/guide/routes.md

@@ -25,6 +25,10 @@ class Ema MyModel Route where
   -- This tells Ema which routes to generate .html files for.
   staticRoutes model =
     [Index, About]
+  -- The fourth method is optional; if you have static assets to serve, specify
+  -- them here. Paths are relative to current working directory.
+  staticAssets Proxy =
+    ["css", "images", "favicon.ico", "resume.pdf"]
   ```
 
 (The `MyModel` type is explained in the [earlier section](guide/model.md)).

ema.cabal

@@ -51,7 +51,7 @@ library
     , stm
     , text
     , wai
-    , wai-app-static
+    , wai-middleware-static
     , wai-websockets
     , warp
     , websockets

src/Ema/App.hs

@@ -5,21 +5,22 @@
 module Ema.App
   ( runEma,
     runEmaPure,
-    runEmaWithAction,
-    runEmaWith,
+    runEmaWithCli,
     Ema (..),
   )
 where
 
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (race_)
 import Data.LVar (LVar)
 import qualified Data.LVar as LVar
-import Ema.CLI (Action (..))
+import Ema.CLI (Action (..), Cli)
 import qualified Ema.CLI as CLI
 import Ema.Class (Ema (..))
 import qualified Ema.Generate as Generate
 import qualified Ema.Server as Server
 import GHC.IO.Handle (BufferMode (LineBuffering), hSetBuffering)
+import System.Directory (getCurrentDirectory, withCurrentDirectory)
 import System.Environment (lookupEnv)
 
 -- | Pure version of @runEmaWith@ (i.e with no model).
@@ -30,12 +31,13 @@ import System.Environment (lookupEnv)
 -- function.
 runEmaPure ::
   -- | How to render a route
-  (Action -> LByteString) ->
+  (Cli -> LByteString) ->
   IO ()
 runEmaPure html = do
-  action <- CLI.cliAction
-  emptyModel <- LVar.new ()
-  runEmaWith @() action emptyModel (\_ () () -> html action)
+  cli <- CLI.cliAction
+  runEmaWithCli cli (\_ () () -> html cli) $ \model -> do
+    LVar.set model ()
+    threadDelay maxBound
 
 -- | Convenient version of @runEmaWith@ that takes initial model and an update
 -- function. You typically want to use this.
@@ -46,40 +48,48 @@ runEma ::
   forall model route.
   (Ema model route, Show route) =>
   -- | How to render a route, given the model
-  (Action -> model -> route -> LByteString) ->
+  (CLI.Action -> model -> route -> LByteString) ->
   -- | A long-running IO action that will update the @model@ @LVar@ over time.
   -- This IO action must set the initial model value in the very beginning.
   (LVar model -> IO ()) ->
   IO ()
 runEma render runModel = do
-  action <- CLI.cliAction
-  runEmaWithAction action render runModel
+  cli <- CLI.cliAction
+  runEmaWithCli cli render runModel
 
 -- | Like @runEma@ but takes the CLI action
 --
 -- Useful if you are handling CLI arguments yourself.
-runEmaWithAction ::
+runEmaWithCli ::
   forall model route.
   (Ema model route, Show route) =>
-  Action ->
+  Cli ->
   -- | How to render a route, given the model
-  (Action -> model -> route -> LByteString) ->
+  (CLI.Action -> model -> route -> LByteString) ->
   -- | A long-running IO action that will update the @model@ @LVar@ over time.
   -- This IO action must set the initial model value in the very beginning.
   (LVar model -> IO ()) ->
   IO ()
-runEmaWithAction action render runModel = do
+runEmaWithCli cli render runModel = do
   model <- LVar.empty
+  -- TODO: Use a logging library, in place of managing buffering and using putStrLn
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+  withCurrentDirectory (CLI.workingDir cli) $ do
+    cwd <- getCurrentDirectory
+    putStrLn $ "Running Ema under: " <> cwd
+    putStrLn "Waiting for initial site model ..."
+    putStrLn "  stuck here? set a model value using `LVar.set`"
     race_
       (runModel model)
-    (runEmaWith action model render)
+      (runEmaWithCliInCwd (CLI.action cli) model render)
 
 -- | Run Ema live dev server
-runEmaWith ::
+runEmaWithCliInCwd ::
   forall model route.
   (Ema model route, Show route) =>
-  -- | CLI Action
-  Action ->
+  -- | CLI arguments
+  CLI.Action ->
   -- | Your site model type, as a @LVar@ in order to support modifications over
   -- time (for hot-reload).
   --
@@ -92,18 +102,13 @@ runEmaWith ::
   -- or generate on disk.
   (Action -> model -> route -> LByteString) ->
   IO ()
-runEmaWith action model render = do
-  -- TODO: Use a logging library, in place of managing buffering and using putStrLn
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stderr LineBuffering
-  putStrLn "Waiting for initial site model ..."
-  putStrLn "  stuck here? set a model value using `LVar.set`"
-  case action of
+runEmaWithCliInCwd cliAction model render = do
+  case cliAction of
     Generate dest -> do
       val <- LVar.get model
-      Generate.generate dest val (render action)
+      Generate.generate dest val (render cliAction)
     Run -> do
       void $ LVar.get model
       port <- fromMaybe 8000 . (readMaybe @Int =<<) <$> lookupEnv "PORT"
       putStrLn $ "Launching Ema at http://localhost:" <> show port
-      Server.runServerWithWebSocketHotReload port model (render action)
+      Server.runServerWithWebSocketHotReload port model (render cliAction)

src/Ema/CLI.hs

@@ -1,32 +1,48 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Ema.CLI where
 
-import Options.Applicative
+import Options.Applicative hiding (action)
+
+data Cli = Cli
+  { workingDir :: FilePath,
+    action :: Action
+  }
+  deriving (Eq, Show)
 
 data Action
   = Generate FilePath
   | Run
   deriving (Eq, Show)
 
-actionParser :: Parser Action
-actionParser =
+cliParser :: Parser Cli
+cliParser = do
+  workingDir <-
+    option
+      str
+      ( short 'C' <> metavar "PATH" <> value "."
+          <> help "Run as if ema was started in PATH instead of the current working directory."
+      )
+  action <-
     subparser
       (command "gen" (info generate (progDesc "Generate static HTML files")))
       <|> pure Run
+  pure Cli {..}
   where
     generate :: Parser Action
     generate =
       Generate <$> argument str (metavar "DEST...")
 
-cliAction :: IO Action
+cliAction :: IO Cli
 cliAction = do
   execParser opts
   where
     opts =
       info
-        (actionParser <**> helper)
+        (cliParser <**> helper)
         ( fullDesc
             <> progDesc "Ema - static site generator"
-            <> header "Ema - header"
+            <> header "Ema"
         )

src/Ema/Class.hs

@@ -17,6 +17,12 @@ class Ema model route | route -> model where
   -- This is never used by the dev server.
   staticRoutes :: model -> [route]
 
+  -- | List of (top-level) filepaths to serve as static assets
+  --
+  -- These will be copied over as-is during static site generation
+  staticAssets :: Proxy route -> [FilePath]
+  staticAssets Proxy = mempty
+
 -- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only.
 instance Ema () () where
   encodeRoute () = []

src/Ema/Example/Ex03_Documentation.hs

@@ -27,7 +27,7 @@ import qualified Ema.CLI
 import qualified Ema.Helper.FileSystem as FileSystem
 import qualified Ema.Helper.Tailwind as Tailwind
 import NeatInterpolation (text)
-import System.FilePath (splitExtension, splitPath, (</>))
+import System.FilePath (splitExtension, splitPath)
 import Text.Blaze.Html5 ((!))
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
@@ -88,20 +88,18 @@ instance Ema Sources SourcePath where
       pure $ Tagged parts
   staticRoutes (Map.keys . untag -> spaths) =
     spaths
+  staticAssets _ =
+    ["ema.svg"]
 
 main :: IO ()
 main =
-  mainWith "docs"
-
-mainWith :: FilePath -> IO ()
-mainWith folder =
   runEma render $ \model -> do
     LVar.set model =<< do
-      putStrLn $ "Loading .md files from " <> folder
-      mdFiles <- FileSystem.filesMatching folder ["**/*.md"]
+      putStrLn "Loading .md files"
+      mdFiles <- FileSystem.filesMatching "." ["**/*.md"]
       forM mdFiles readSource
         <&> Tagged . Map.fromList . catMaybes
-    FileSystem.onChange folder $ \fp -> \case
+    FileSystem.onChange "." $ \fp -> \case
       FileSystem.Update ->
         whenJustM (readSource fp) $ \(spath, s) -> do
           putStrLn $ "Update: " <> show spath
@@ -115,7 +113,7 @@ mainWith folder =
     readSource fp =
       runMaybeT $ do
         spath :: SourcePath <- MaybeT $ pure $ mkSourcePath fp
-        s <- readFileText $ folder </> fp
+        s <- readFileText fp
         pure (spath, parseMarkdown s)
 
 newtype BadRoute = BadRoute SourcePath
@@ -178,7 +176,7 @@ render emaAction srcs spath = do
     favIcon = do
       H.unsafeByteString . encodeUtf8 $
         [text|
-        <link href="https://raw.githubusercontent.com/srid/ema/master/ema.svg" rel="icon" />
+        <link href="/ema.svg" rel="icon" />
         |]
 
 lookupTitleForgiving :: Sources -> SourcePath -> Text

src/Ema/Generate.hs

@@ -1,12 +1,15 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Ema.Generate where
 
+import Control.Exception (throw)
 import Ema.Class
 import Ema.Route (routeFile)
-import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
+import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.FilePath (takeDirectory, (</>))
+import System.FilePattern.Directory (getDirectoryFiles)
 
 generate ::
   forall model route.
@@ -22,7 +25,37 @@ generate dest model render = do
   putStrLn $ "Writing " <> show (length routes) <> " routes"
   forM_ routes $ \r -> do
     let fp = dest </> routeFile @model r
-        !s = render model r
-    createDirectoryIfMissing True (takeDirectory fp)
     putStrLn $ "W " <> fp
+    let !s = render model r
+    createDirectoryIfMissing True (takeDirectory fp)
     writeFileLBS fp s
+  forM_ (staticAssets $ Proxy @route) $ \staticPath -> do
+    copyDirRecursively staticPath dest
+
+newtype StaticAssetMissing = StaticAssetMissing FilePath
+  deriving (Show, Exception)
+
+copyDirRecursively ::
+  -- | Source file or directory relative to CWD that will be copied
+  FilePath ->
+  -- | Directory *under* which the source file/dir will be copied
+  FilePath ->
+  IO ()
+copyDirRecursively srcRel destParent =
+  doesFileExist srcRel >>= \case
+    True -> do
+      let b = destParent </> srcRel
+      putStrLn $ "C " <> b
+      copyFile srcRel b
+    False ->
+      doesDirectoryExist srcRel >>= \case
+        False ->
+          throw $ StaticAssetMissing srcRel
+        True -> do
+          fs <- getDirectoryFiles srcRel ["**"]
+          forM_ fs $ \fp -> do
+            let a = srcRel </> fp
+                b = destParent </> srcRel </> fp
+            putStrLn $ "C " <> b
+            createDirectoryIfMissing True (takeDirectory b)
+            copyFile a b

src/Ema/Server.hs

@@ -9,13 +9,14 @@ import Control.Exception (catch, try)
 import Data.LVar (LVar)
 import qualified Data.LVar as LVar
 import qualified Data.Text as T
-import Ema.Class (Ema (decodeRoute))
+import Ema.Class (Ema (decodeRoute, staticAssets))
 import GHC.IO.Unsafe (unsafePerformIO)
 import NeatInterpolation (text)
 import qualified Network.HTTP.Types as H
 import qualified Network.Wai as Wai
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Handler.WebSockets as WaiWs
+import qualified Network.Wai.Middleware.Static as Static
 import Network.WebSockets (ConnectionException)
 import qualified Network.WebSockets as WS
 
@@ -28,7 +29,7 @@ runServerWithWebSocketHotReload ::
   IO ()
 runServerWithWebSocketHotReload port model render = do
   let settings = Warp.setPort port Warp.defaultSettings
-  Warp.runSettings settings $ WaiWs.websocketsOr WS.defaultConnectionOptions wsApp httpApp
+  Warp.runSettings settings $ assetsMiddleware $ WaiWs.websocketsOr WS.defaultConnectionOptions wsApp httpApp
   where
     wsApp pendingConn = do
       conn :: WS.Connection <- WS.acceptRequest pendingConn
@@ -76,6 +77,10 @@ runServerWithWebSocketHotReload port model render = do
           Left (err :: ConnectionException) -> do
             log $ "ws:error " <> show err
             LVar.removeListener model subId
+    assetsMiddleware = do
+      Static.staticPolicy $
+        flip foldMap (staticAssets $ Proxy @route) $ \path ->
+          Static.hasPrefix path
     httpApp req f = do
       let mr = routeFromPathInfo (Wai.pathInfo req)
       putStrLn $ "[http] " <> show mr