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:
parent
61b3191792
commit
2d6bb31467
@ -112,7 +112,6 @@ library
|
|||||||
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Ema.App
|
Ema.App
|
||||||
Ema.Class
|
|
||||||
Ema.Generate
|
Ema.Generate
|
||||||
Ema.Route
|
Ema.Route
|
||||||
Ema.Route.Slug
|
Ema.Route.Slug
|
||||||
|
@ -6,5 +6,4 @@ module Ema
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Ema.App as X
|
import Ema.App as X
|
||||||
import Ema.Class as X
|
|
||||||
import Ema.Route as X
|
import Ema.Route as X
|
||||||
|
@ -8,7 +8,6 @@ module Ema.App
|
|||||||
( runEma,
|
( runEma,
|
||||||
runEmaPure,
|
runEmaPure,
|
||||||
runEmaWithCli,
|
runEmaWithCli,
|
||||||
MonadEma,
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -20,11 +19,12 @@ import Data.LVar (LVar)
|
|||||||
import qualified Data.LVar as LVar
|
import qualified Data.LVar as LVar
|
||||||
import Ema.CLI (Action (..), Cli)
|
import Ema.CLI (Action (..), Cli)
|
||||||
import qualified Ema.CLI as CLI
|
import qualified Ema.CLI as CLI
|
||||||
import Ema.Class (Ema (..), MonadEma)
|
|
||||||
import qualified Ema.Generate as Generate
|
import qualified Ema.Generate as Generate
|
||||||
|
import Ema.Route (HtmlRoute (..))
|
||||||
import qualified Ema.Server as Server
|
import qualified Ema.Server as Server
|
||||||
import System.Directory (getCurrentDirectory, withCurrentDirectory)
|
import System.Directory (getCurrentDirectory, withCurrentDirectory)
|
||||||
import System.Environment (lookupEnv)
|
import System.Environment (lookupEnv)
|
||||||
|
import UnliftIO (MonadUnliftIO)
|
||||||
|
|
||||||
-- | Pure version of @runEmaWith@ (i.e with no model).
|
-- | Pure version of @runEmaWith@ (i.e with no model).
|
||||||
--
|
--
|
||||||
@ -48,14 +48,14 @@ runEmaPure render = do
|
|||||||
-- exits, and vice-versa.
|
-- exits, and vice-versa.
|
||||||
runEma ::
|
runEma ::
|
||||||
forall model route.
|
forall model route.
|
||||||
(Ema route, Show route) =>
|
(HtmlRoute route, Show route) =>
|
||||||
[FilePath] ->
|
[FilePath] ->
|
||||||
(model -> [route]) ->
|
(model -> [route]) ->
|
||||||
-- | How to render a route, given the model
|
-- | How to render a route, given the model
|
||||||
(CLI.Action -> model -> route -> LByteString) ->
|
(CLI.Action -> model -> route -> LByteString) ->
|
||||||
-- | A long-running IO action that will update the @model@ @LVar@ over time.
|
-- | 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.
|
-- 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 ()
|
IO ()
|
||||||
runEma staticAssets staticRoutes render runModel = do
|
runEma staticAssets staticRoutes render runModel = do
|
||||||
cli <- CLI.cliAction
|
cli <- CLI.cliAction
|
||||||
@ -66,7 +66,7 @@ runEma staticAssets staticRoutes render runModel = do
|
|||||||
-- Useful if you are handling CLI arguments yourself.
|
-- Useful if you are handling CLI arguments yourself.
|
||||||
runEmaWithCli ::
|
runEmaWithCli ::
|
||||||
forall model route.
|
forall model route.
|
||||||
(Ema route, Show route) =>
|
(HtmlRoute route, Show route) =>
|
||||||
Cli ->
|
Cli ->
|
||||||
[FilePath] ->
|
[FilePath] ->
|
||||||
(model -> [route]) ->
|
(model -> [route]) ->
|
||||||
@ -74,7 +74,7 @@ runEmaWithCli ::
|
|||||||
(CLI.Action -> model -> route -> LByteString) ->
|
(CLI.Action -> model -> route -> LByteString) ->
|
||||||
-- | A long-running IO action that will update the @model@ @LVar@ over time.
|
-- | 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.
|
-- 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 ()
|
IO ()
|
||||||
runEmaWithCli cli staticAssets staticRoutes render runModel = do
|
runEmaWithCli cli staticAssets staticRoutes render runModel = do
|
||||||
model <- LVar.empty
|
model <- LVar.empty
|
||||||
@ -93,7 +93,7 @@ runEmaWithCli cli staticAssets staticRoutes render runModel = do
|
|||||||
-- | Run Ema live dev server
|
-- | Run Ema live dev server
|
||||||
runEmaWithCliInCwd ::
|
runEmaWithCliInCwd ::
|
||||||
forall model route m.
|
forall model route m.
|
||||||
(MonadEma m, Ema route, Show route) =>
|
(MonadIO m, MonadUnliftIO m, MonadLoggerIO m, HtmlRoute route, Show route) =>
|
||||||
-- | CLI arguments
|
-- | CLI arguments
|
||||||
CLI.Action ->
|
CLI.Action ->
|
||||||
-- | Your site model type, as a @LVar@ in order to support modifications over
|
-- | 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 Control.Concurrent (threadDelay)
|
||||||
import qualified Data.LVar as LVar
|
import qualified Data.LVar as LVar
|
||||||
import Ema (Ema (..))
|
import Ema (HtmlRoute (..))
|
||||||
import qualified Ema
|
import qualified Ema
|
||||||
import qualified Ema.CLI
|
import qualified Ema.CLI
|
||||||
import qualified Ema.Helper.Tailwind as Tailwind
|
import qualified Ema.Helper.Tailwind as Tailwind
|
||||||
@ -25,7 +25,7 @@ data Route
|
|||||||
|
|
||||||
data Model = Model Text
|
data Model = Model Text
|
||||||
|
|
||||||
instance Ema Route where
|
instance HtmlRoute Route where
|
||||||
encodeRoute = \case
|
encodeRoute = \case
|
||||||
Index -> mempty
|
Index -> mempty
|
||||||
About -> one "about"
|
About -> one "about"
|
||||||
|
@ -13,7 +13,7 @@ import Control.Concurrent (threadDelay)
|
|||||||
import qualified Data.LVar as LVar
|
import qualified Data.LVar as LVar
|
||||||
import Data.List ((!!))
|
import Data.List ((!!))
|
||||||
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
|
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
|
||||||
import Ema (Ema (..), routeUrl, runEma)
|
import Ema (HtmlRoute (..), routeUrl, runEma)
|
||||||
import qualified Ema.CLI
|
import qualified Ema.CLI
|
||||||
import qualified Ema.Helper.Tailwind as Tailwind
|
import qualified Ema.Helper.Tailwind as Tailwind
|
||||||
import Text.Blaze.Html5 ((!))
|
import Text.Blaze.Html5 ((!))
|
||||||
@ -25,7 +25,7 @@ data Route
|
|||||||
| OnlyTime
|
| OnlyTime
|
||||||
deriving (Show, Enum, Bounded)
|
deriving (Show, Enum, Bounded)
|
||||||
|
|
||||||
instance Ema Route where
|
instance HtmlRoute Route where
|
||||||
encodeRoute = \case
|
encodeRoute = \case
|
||||||
Index -> mempty
|
Index -> mempty
|
||||||
OnlyTime -> one "time"
|
OnlyTime -> one "time"
|
||||||
|
@ -6,18 +6,22 @@ module Ema.Generate where
|
|||||||
|
|
||||||
import Control.Exception (throw)
|
import Control.Exception (throw)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Ema.Class (Ema, MonadEma)
|
import Ema.Route (HtmlRoute, routeFile)
|
||||||
import Ema.Route (routeFile)
|
|
||||||
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist)
|
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist)
|
||||||
import System.FilePath (takeDirectory, (</>))
|
import System.FilePath (takeDirectory, (</>))
|
||||||
import System.FilePattern.Directory (getDirectoryFiles)
|
import System.FilePattern.Directory (getDirectoryFiles)
|
||||||
|
import UnliftIO (MonadUnliftIO)
|
||||||
|
|
||||||
log :: MonadLogger m => LogLevel -> Text -> m ()
|
log :: MonadLogger m => LogLevel -> Text -> m ()
|
||||||
log = logWithoutLoc "Generate"
|
log = logWithoutLoc "Generate"
|
||||||
|
|
||||||
generate ::
|
generate ::
|
||||||
forall model route m.
|
forall model route m.
|
||||||
(MonadEma m, Ema route) =>
|
( MonadIO m,
|
||||||
|
MonadUnliftIO m,
|
||||||
|
MonadLoggerIO m,
|
||||||
|
HtmlRoute route
|
||||||
|
) =>
|
||||||
FilePath ->
|
FilePath ->
|
||||||
model ->
|
model ->
|
||||||
[FilePath] ->
|
[FilePath] ->
|
||||||
@ -46,7 +50,10 @@ newtype StaticAssetMissing = StaticAssetMissing FilePath
|
|||||||
deriving (Show, Exception)
|
deriving (Show, Exception)
|
||||||
|
|
||||||
copyDirRecursively ::
|
copyDirRecursively ::
|
||||||
MonadEma m =>
|
( MonadIO m,
|
||||||
|
MonadUnliftIO m,
|
||||||
|
MonadLoggerIO m
|
||||||
|
) =>
|
||||||
-- | Source file or directory relative to CWD that will be copied
|
-- | Source file or directory relative to CWD that will be copied
|
||||||
FilePath ->
|
FilePath ->
|
||||||
-- | Directory *under* which the source file/dir will be copied
|
-- | Directory *under* which the source file/dir will be copied
|
||||||
|
@ -2,7 +2,8 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Ema.Route
|
module Ema.Route
|
||||||
( routeUrl,
|
( HtmlRoute (..),
|
||||||
|
routeUrl,
|
||||||
routeFile,
|
routeFile,
|
||||||
Slug (unSlug),
|
Slug (unSlug),
|
||||||
decodeSlug,
|
decodeSlug,
|
||||||
@ -12,7 +13,6 @@ module Ema.Route
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Data.Default (def)
|
import Data.Default (def)
|
||||||
import Ema.Class
|
|
||||||
import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug)
|
import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug)
|
||||||
import Ema.Route.UrlStrategy
|
import Ema.Route.UrlStrategy
|
||||||
( UrlStrategy (..),
|
( UrlStrategy (..),
|
||||||
@ -20,14 +20,27 @@ import Ema.Route.UrlStrategy
|
|||||||
slugRelUrlWithStrategy,
|
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
|
-- | Return the relative URL of the given route
|
||||||
--
|
--
|
||||||
-- As the returned URL is relative, you will have to either make it absolute (by
|
-- 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.
|
-- 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 =
|
routeUrl r =
|
||||||
slugRelUrlWithStrategy def (encodeRoute r)
|
slugRelUrlWithStrategy def (encodeRoute r)
|
||||||
|
|
||||||
routeFile :: forall r. Ema r => r -> FilePath
|
routeFile :: forall r. HtmlRoute r => r -> FilePath
|
||||||
routeFile r =
|
routeFile r =
|
||||||
slugFileWithStrategy def (encodeRoute r)
|
slugFileWithStrategy def (encodeRoute r)
|
||||||
|
@ -9,7 +9,7 @@ import Control.Monad.Logger
|
|||||||
import Data.LVar (LVar)
|
import Data.LVar (LVar)
|
||||||
import qualified Data.LVar as LVar
|
import qualified Data.LVar as LVar
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Ema.Class (Ema (decodeRoute), MonadEma)
|
import Ema.Route (HtmlRoute (..))
|
||||||
import qualified Ema.Route.Slug as Slug
|
import qualified Ema.Route.Slug as Slug
|
||||||
import GHC.IO.Unsafe (unsafePerformIO)
|
import GHC.IO.Unsafe (unsafePerformIO)
|
||||||
import NeatInterpolation (text)
|
import NeatInterpolation (text)
|
||||||
@ -22,10 +22,16 @@ import Network.WebSockets (ConnectionException)
|
|||||||
import qualified Network.WebSockets as WS
|
import qualified Network.WebSockets as WS
|
||||||
import Relude.Extra.Foldable1 (foldl1')
|
import Relude.Extra.Foldable1 (foldl1')
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
import UnliftIO (MonadUnliftIO)
|
||||||
|
|
||||||
runServerWithWebSocketHotReload ::
|
runServerWithWebSocketHotReload ::
|
||||||
forall model route m.
|
forall model route m.
|
||||||
(Ema route, Show route, MonadEma m) =>
|
( HtmlRoute route,
|
||||||
|
Show route,
|
||||||
|
MonadIO m,
|
||||||
|
MonadUnliftIO m,
|
||||||
|
MonadLoggerIO m
|
||||||
|
) =>
|
||||||
Int ->
|
Int ->
|
||||||
LVar model ->
|
LVar model ->
|
||||||
[FilePath] ->
|
[FilePath] ->
|
||||||
|
Loading…
Reference in New Issue
Block a user