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

... fundeps no longer needed

Because ejecting staticRoutes also ejected the 'model' class argument
This commit is contained in:
Sridhar Ratnakumar 2021-05-21 14:17:00 -04:00
parent be9dfe6207
commit 494b90bf18
7 changed files with 15 additions and 16 deletions

View File

@ -48,7 +48,7 @@ runEmaPure render = do
-- exits, and vice-versa. -- exits, and vice-versa.
runEma :: runEma ::
forall model route. forall model route.
(Ema model route, Show route) => (Ema route, Show route) =>
(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) ->
@ -65,7 +65,7 @@ runEma 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 model route, Show route) => (Ema route, Show route) =>
Cli -> Cli ->
(model -> [route]) -> (model -> [route]) ->
-- | How to render a route, given the model -- | How to render a route, given the model
@ -91,7 +91,7 @@ runEmaWithCli cli 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 model route, Show route) => (MonadEma m, Ema 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

View File

@ -1,6 +1,5 @@
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
@ -17,7 +16,7 @@ type MonadEma m =
) )
-- | Enrich a model to work with Ema -- | Enrich a model to work with Ema
class Ema model route | route -> model where class Ema route where
-- How to convert URLs to/from routes -- How to convert URLs to/from routes
encodeRoute :: route -> [Slug] encodeRoute :: route -> [Slug]
decodeRoute :: [Slug] -> Maybe route decodeRoute :: [Slug] -> Maybe route
@ -29,7 +28,7 @@ class Ema model route | route -> model where
staticAssets Proxy = mempty staticAssets Proxy = mempty
-- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only. -- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only.
instance Ema () () where instance Ema () where
encodeRoute () = [] encodeRoute () = []
decodeRoute = \case decodeRoute = \case
[] -> Just () [] -> Just ()

View File

@ -25,7 +25,7 @@ data Route
data Model = Model Text data Model = Model Text
instance Ema Model Route where instance Ema Route where
encodeRoute = \case encodeRoute = \case
Index -> mempty Index -> mempty
About -> one "about" About -> one "about"

View File

@ -25,7 +25,7 @@ data Route
| OnlyTime | OnlyTime
deriving (Show, Enum, Bounded) deriving (Show, Enum, Bounded)
instance Ema UTCTime Route where instance Ema Route where
encodeRoute = \case encodeRoute = \case
Index -> mempty Index -> mempty
OnlyTime -> one "time" OnlyTime -> one "time"

View File

@ -17,7 +17,7 @@ log = logWithoutLoc "Generate"
generate :: generate ::
forall model route m. forall model route m.
(MonadEma m, Ema model route) => (MonadEma m, Ema route) =>
FilePath -> FilePath ->
model -> model ->
[route] -> [route] ->
@ -28,7 +28,7 @@ generate dest model routes render = do
error $ "Destination does not exist: " <> toText dest error $ "Destination does not exist: " <> toText dest
log LevelInfo $ "Writing " <> show (length routes) <> " routes" log LevelInfo $ "Writing " <> show (length routes) <> " routes"
forM_ routes $ \r -> do forM_ routes $ \r -> do
let fp = dest </> routeFile @model r let fp = dest </> routeFile r
log LevelInfo $ toText $ "W " <> fp log LevelInfo $ toText $ "W " <> fp
let !s = render model r let !s = render model r
liftIO $ do liftIO $ do

View File

@ -24,10 +24,10 @@ import Ema.Route.UrlStrategy
-- --
-- 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 a r. Ema a r => r -> Text routeUrl :: forall r. Ema r => r -> Text
routeUrl r = routeUrl r =
slugRelUrlWithStrategy def (encodeRoute @a r) slugRelUrlWithStrategy def (encodeRoute r)
routeFile :: forall a r. Ema a r => r -> FilePath routeFile :: forall r. Ema r => r -> FilePath
routeFile r = routeFile r =
slugFileWithStrategy def (encodeRoute @a r) slugFileWithStrategy def (encodeRoute r)

View File

@ -25,7 +25,7 @@ import Text.Printf (printf)
runServerWithWebSocketHotReload :: runServerWithWebSocketHotReload ::
forall model route m. forall model route m.
(Ema model route, Show route, MonadEma m) => (Ema route, Show route, MonadEma m) =>
Int -> Int ->
LVar model -> LVar model ->
(model -> route -> LByteString) -> (model -> route -> LByteString) ->
@ -127,7 +127,7 @@ runServerWithWebSocketHotReload port model render = do
<> show @Text err <> show @Text err
<> "</pre><p>Once you fix your code this page will automatically update.</body>" <> "</pre><p>Once you fix your code this page will automatically update.</body>"
routeFromPathInfo = routeFromPathInfo =
decodeRoute @model . fmap Slug.decodeSlug decodeRoute @route . fmap Slug.decodeSlug
-- TODO: It would be good have this also get us the stack trace. -- TODO: It would be good have this also get us the stack trace.
unsafeCatch :: Exception e => a -> (e -> a) -> a unsafeCatch :: Exception e => a -> (e -> a) -> a
unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f) unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f)