mirror of
https://github.com/srid/ema.git
synced 2024-12-01 23:23:42 +03:00
Drop Ema typeclass; add back as HtmlRoute typeclass
This commit is contained in:
parent
61b3191792
commit
2d6bb31467
@ -112,7 +112,6 @@ library
|
||||
|
||||
other-modules:
|
||||
Ema.App
|
||||
Ema.Class
|
||||
Ema.Generate
|
||||
Ema.Route
|
||||
Ema.Route.Slug
|
||||
|
@ -6,5 +6,4 @@ module Ema
|
||||
where
|
||||
|
||||
import Ema.App as X
|
||||
import Ema.Class as X
|
||||
import Ema.Route as X
|
||||
|
@ -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
|
||||
|
@ -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
|
@ -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"
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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] ->
|
||||
|
Loading…
Reference in New Issue
Block a user