1
1
mirror of https://github.com/srid/ema.git synced 2024-12-02 09:15:10 +03:00

Drop Ema typeclass; add back as HtmlRoute typeclass

This commit is contained in:
Sridhar Ratnakumar 2021-05-21 16:19:57 -04:00
parent 61b3191792
commit 2d6bb31467
9 changed files with 47 additions and 52 deletions

View File

@ -112,7 +112,6 @@ library
other-modules:
Ema.App
Ema.Class
Ema.Generate
Ema.Route
Ema.Route.Slug

View File

@ -6,5 +6,4 @@ module Ema
where
import Ema.App as X
import Ema.Class as X
import Ema.Route as X

View File

@ -8,7 +8,6 @@ module Ema.App
( runEma,
runEmaPure,
runEmaWithCli,
MonadEma,
)
where
@ -20,11 +19,12 @@ import Data.LVar (LVar)
import qualified Data.LVar as LVar
import Ema.CLI (Action (..), Cli)
import qualified Ema.CLI as CLI
import Ema.Class (Ema (..), MonadEma)
import qualified Ema.Generate as Generate
import Ema.Route (HtmlRoute (..))
import qualified Ema.Server as Server
import System.Directory (getCurrentDirectory, withCurrentDirectory)
import System.Environment (lookupEnv)
import UnliftIO (MonadUnliftIO)
-- | Pure version of @runEmaWith@ (i.e with no model).
--
@ -48,14 +48,14 @@ runEmaPure render = do
-- exits, and vice-versa.
runEma ::
forall model route.
(Ema route, Show route) =>
(HtmlRoute route, Show route) =>
[FilePath] ->
(model -> [route]) ->
-- | How to render a route, given the model
(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.
(forall m. MonadEma m => LVar model -> m ()) ->
(forall m. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => LVar model -> m ()) ->
IO ()
runEma staticAssets staticRoutes render runModel = do
cli <- CLI.cliAction
@ -66,7 +66,7 @@ runEma staticAssets staticRoutes render runModel = do
-- Useful if you are handling CLI arguments yourself.
runEmaWithCli ::
forall model route.
(Ema route, Show route) =>
(HtmlRoute route, Show route) =>
Cli ->
[FilePath] ->
(model -> [route]) ->
@ -74,7 +74,7 @@ runEmaWithCli ::
(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.
(forall m. MonadEma m => LVar model -> m ()) ->
(forall m. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => LVar model -> m ()) ->
IO ()
runEmaWithCli cli staticAssets staticRoutes render runModel = do
model <- LVar.empty
@ -93,7 +93,7 @@ runEmaWithCli cli staticAssets staticRoutes render runModel = do
-- | Run Ema live dev server
runEmaWithCliInCwd ::
forall model route m.
(MonadEma m, Ema route, Show route) =>
(MonadIO m, MonadUnliftIO m, MonadLoggerIO m, HtmlRoute route, Show route) =>
-- | CLI arguments
CLI.Action ->
-- | Your site model type, as a @LVar@ in order to support modifications over

View File

@ -1,29 +0,0 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Ema.Class where
import Control.Monad.Logger (MonadLoggerIO)
import Ema.Route.Slug (Slug)
import UnliftIO (MonadUnliftIO)
type MonadEma m =
( MonadIO m,
MonadUnliftIO m,
MonadLoggerIO m
)
-- | Enrich a model to work with Ema
class Ema route where
-- How to convert URLs to/from routes
encodeRoute :: route -> [Slug]
decodeRoute :: [Slug] -> Maybe route
-- | 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 () = []
decodeRoute = \case
[] -> Just ()
_ -> Nothing

View File

@ -10,7 +10,7 @@ module Ema.Example.Ex02_Basic where
import Control.Concurrent (threadDelay)
import qualified Data.LVar as LVar
import Ema (Ema (..))
import Ema (HtmlRoute (..))
import qualified Ema
import qualified Ema.CLI
import qualified Ema.Helper.Tailwind as Tailwind
@ -25,7 +25,7 @@ data Route
data Model = Model Text
instance Ema Route where
instance HtmlRoute Route where
encodeRoute = \case
Index -> mempty
About -> one "about"

View File

@ -13,7 +13,7 @@ import Control.Concurrent (threadDelay)
import qualified Data.LVar as LVar
import Data.List ((!!))
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
import Ema (Ema (..), routeUrl, runEma)
import Ema (HtmlRoute (..), routeUrl, runEma)
import qualified Ema.CLI
import qualified Ema.Helper.Tailwind as Tailwind
import Text.Blaze.Html5 ((!))
@ -25,7 +25,7 @@ data Route
| OnlyTime
deriving (Show, Enum, Bounded)
instance Ema Route where
instance HtmlRoute Route where
encodeRoute = \case
Index -> mempty
OnlyTime -> one "time"

View File

@ -6,18 +6,22 @@ module Ema.Generate where
import Control.Exception (throw)
import Control.Monad.Logger
import Ema.Class (Ema, MonadEma)
import Ema.Route (routeFile)
import Ema.Route (HtmlRoute, routeFile)
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist)
import System.FilePath (takeDirectory, (</>))
import System.FilePattern.Directory (getDirectoryFiles)
import UnliftIO (MonadUnliftIO)
log :: MonadLogger m => LogLevel -> Text -> m ()
log = logWithoutLoc "Generate"
generate ::
forall model route m.
(MonadEma m, Ema route) =>
( MonadIO m,
MonadUnliftIO m,
MonadLoggerIO m,
HtmlRoute route
) =>
FilePath ->
model ->
[FilePath] ->
@ -46,7 +50,10 @@ newtype StaticAssetMissing = StaticAssetMissing FilePath
deriving (Show, Exception)
copyDirRecursively ::
MonadEma m =>
( MonadIO m,
MonadUnliftIO m,
MonadLoggerIO m
) =>
-- | Source file or directory relative to CWD that will be copied
FilePath ->
-- | Directory *under* which the source file/dir will be copied

View File

@ -2,7 +2,8 @@
{-# LANGUAGE TypeApplications #-}
module Ema.Route
( routeUrl,
( HtmlRoute (..),
routeUrl,
routeFile,
Slug (unSlug),
decodeSlug,
@ -12,7 +13,6 @@ module Ema.Route
where
import Data.Default (def)
import Ema.Class
import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug)
import Ema.Route.UrlStrategy
( UrlStrategy (..),
@ -20,14 +20,27 @@ import Ema.Route.UrlStrategy
slugRelUrlWithStrategy,
)
-- | Route to the generated HTML file.
class HtmlRoute route where
-- How to convert URLs to/from routes
encodeRoute :: route -> [Slug]
decodeRoute :: [Slug] -> Maybe route
-- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only.
instance HtmlRoute () where
encodeRoute () = []
decodeRoute = \case
[] -> Just ()
_ -> Nothing
-- | Return the relative URL of the given route
--
-- As the returned URL is relative, you will have to either make it absolute (by
-- prepending with `/`) or set the `<base>` URL in your HTML head element.
routeUrl :: forall r. Ema r => r -> Text
routeUrl :: forall r. HtmlRoute r => r -> Text
routeUrl r =
slugRelUrlWithStrategy def (encodeRoute r)
routeFile :: forall r. Ema r => r -> FilePath
routeFile :: forall r. HtmlRoute r => r -> FilePath
routeFile r =
slugFileWithStrategy def (encodeRoute r)

View File

@ -9,7 +9,7 @@ import Control.Monad.Logger
import Data.LVar (LVar)
import qualified Data.LVar as LVar
import qualified Data.Text as T
import Ema.Class (Ema (decodeRoute), MonadEma)
import Ema.Route (HtmlRoute (..))
import qualified Ema.Route.Slug as Slug
import GHC.IO.Unsafe (unsafePerformIO)
import NeatInterpolation (text)
@ -22,10 +22,16 @@ import Network.WebSockets (ConnectionException)
import qualified Network.WebSockets as WS
import Relude.Extra.Foldable1 (foldl1')
import Text.Printf (printf)
import UnliftIO (MonadUnliftIO)
runServerWithWebSocketHotReload ::
forall model route m.
(Ema route, Show route, MonadEma m) =>
( HtmlRoute route,
Show route,
MonadIO m,
MonadUnliftIO m,
MonadLoggerIO m
) =>
Int ->
LVar model ->
[FilePath] ->