From 2d6bb3146716d15cc45daf402652a9625c5780cc Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Fri, 21 May 2021 16:19:57 -0400 Subject: [PATCH] Drop Ema typeclass; add back as HtmlRoute typeclass --- ema.cabal | 1 - src/Ema.hs | 1 - src/Ema/App.hs | 14 +++++++------- src/Ema/Class.hs | 29 ----------------------------- src/Ema/Example/Ex02_Basic.hs | 4 ++-- src/Ema/Example/Ex03_Clock.hs | 4 ++-- src/Ema/Generate.hs | 15 +++++++++++---- src/Ema/Route.hs | 21 +++++++++++++++++---- src/Ema/Server.hs | 10 ++++++++-- 9 files changed, 47 insertions(+), 52 deletions(-) delete mode 100644 src/Ema/Class.hs diff --git a/ema.cabal b/ema.cabal index 5870116..4dec6b8 100644 --- a/ema.cabal +++ b/ema.cabal @@ -112,7 +112,6 @@ library other-modules: Ema.App - Ema.Class Ema.Generate Ema.Route Ema.Route.Slug diff --git a/src/Ema.hs b/src/Ema.hs index 96724f0..7d0e755 100644 --- a/src/Ema.hs +++ b/src/Ema.hs @@ -6,5 +6,4 @@ module Ema where import Ema.App as X -import Ema.Class as X import Ema.Route as X diff --git a/src/Ema/App.hs b/src/Ema/App.hs index 1a6d6d9..5b73d30 100644 --- a/src/Ema/App.hs +++ b/src/Ema/App.hs @@ -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 diff --git a/src/Ema/Class.hs b/src/Ema/Class.hs deleted file mode 100644 index b30b9b4..0000000 --- a/src/Ema/Class.hs +++ /dev/null @@ -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 diff --git a/src/Ema/Example/Ex02_Basic.hs b/src/Ema/Example/Ex02_Basic.hs index e6bafdd..fa3df09 100644 --- a/src/Ema/Example/Ex02_Basic.hs +++ b/src/Ema/Example/Ex02_Basic.hs @@ -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" diff --git a/src/Ema/Example/Ex03_Clock.hs b/src/Ema/Example/Ex03_Clock.hs index 67a8431..f7f68a2 100644 --- a/src/Ema/Example/Ex03_Clock.hs +++ b/src/Ema/Example/Ex03_Clock.hs @@ -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" diff --git a/src/Ema/Generate.hs b/src/Ema/Generate.hs index fd93b49..ad7fbd3 100644 --- a/src/Ema/Generate.hs +++ b/src/Ema/Generate.hs @@ -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 diff --git a/src/Ema/Route.hs b/src/Ema/Route.hs index 24af4da..f1bfd3e 100644 --- a/src/Ema/Route.hs +++ b/src/Ema/Route.hs @@ -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 `` 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) diff --git a/src/Ema/Server.hs b/src/Ema/Server.hs index a65d9c7..c370857 100644 --- a/src/Ema/Server.hs +++ b/src/Ema/Server.hs @@ -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] ->