From 7f6f15946c3d22c149de5bdcd76c27305c172ba9 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Fri, 21 May 2021 21:06:10 -0400 Subject: [PATCH] Simplify FileRoute further by using FilePath instead of [Slug] --- ema.cabal | 1 - src/Ema/Example/Ex02_Basic.hs | 14 ++++---- src/Ema/Example/Ex03_Clock.hs | 13 ++++---- src/Ema/Generate.hs | 4 +-- src/Ema/Helper/FileSystem.hs | 2 +- src/Ema/Route.hs | 62 +++++++++++++++++++++-------------- src/Ema/Route/Slug.hs | 9 ++--- src/Ema/Route/UrlStrategy.hs | 49 --------------------------- src/Ema/Server.hs | 5 ++- 9 files changed, 61 insertions(+), 98 deletions(-) delete mode 100644 src/Ema/Route/UrlStrategy.hs diff --git a/ema.cabal b/ema.cabal index 4dec6b8..46f1fee 100644 --- a/ema.cabal +++ b/ema.cabal @@ -115,7 +115,6 @@ library Ema.Generate Ema.Route Ema.Route.Slug - Ema.Route.UrlStrategy Ema.Server if flag(with-examples) diff --git a/src/Ema/Example/Ex02_Basic.hs b/src/Ema/Example/Ex02_Basic.hs index fadb7b7..7cec0df 100644 --- a/src/Ema/Example/Ex02_Basic.hs +++ b/src/Ema/Example/Ex02_Basic.hs @@ -26,13 +26,13 @@ data Route data Model = Model Text instance FileRoute Route where - encodeRoute = - Ema.htmlSlugs . \case - Index -> mempty - About -> one "about" - decodeRoute = \case - [] -> Just Index - ["about"] -> Just About + encodeFileRoute = + \case + Index -> "index.html" + About -> "about.html" + decodeFileRoute = \case + "index.html" -> Just Index + "about.html" -> Just About _ -> Nothing main :: IO () diff --git a/src/Ema/Example/Ex03_Clock.hs b/src/Ema/Example/Ex03_Clock.hs index 87291a3..864feb4 100644 --- a/src/Ema/Example/Ex03_Clock.hs +++ b/src/Ema/Example/Ex03_Clock.hs @@ -27,13 +27,12 @@ data Route deriving (Show, Enum, Bounded) instance FileRoute Route where - encodeRoute = - Ema.htmlSlugs . \case - Index -> mempty - OnlyTime -> one "time" - decodeRoute = \case - [] -> Just Index - ["time"] -> Just OnlyTime + encodeFileRoute = \case + Index -> "index.html" + OnlyTime -> "time.html" + decodeFileRoute = \case + "index.html" -> Just Index + "time.html" -> Just OnlyTime _ -> Nothing main :: IO () diff --git a/src/Ema/Generate.hs b/src/Ema/Generate.hs index f075d27..8350126 100644 --- a/src/Ema/Generate.hs +++ b/src/Ema/Generate.hs @@ -6,7 +6,7 @@ module Ema.Generate where import Control.Exception (throw) import Control.Monad.Logger -import Ema.Route (FileRoute, routeFile) +import Ema.Route (FileRoute (encodeFileRoute)) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist) import System.FilePath (takeDirectory, ()) import System.FilePattern.Directory (getDirectoryFiles) @@ -33,7 +33,7 @@ generate dest model staticAssets routes render = do error $ "Destination does not exist: " <> toText dest log LevelInfo $ "Writing " <> show (length routes) <> " routes" forM_ routes $ \r -> do - let fp = dest routeFile r + let fp = dest encodeFileRoute r log LevelInfo $ toText $ "W " <> fp let !s = render model r liftIO $ do diff --git a/src/Ema/Helper/FileSystem.hs b/src/Ema/Helper/FileSystem.hs index 6daadf1..ad554ee 100644 --- a/src/Ema/Helper/FileSystem.hs +++ b/src/Ema/Helper/FileSystem.hs @@ -35,7 +35,7 @@ import System.FSNotify withManager, ) import System.FilePath (isRelative, makeRelative) -import System.FilePattern (FilePattern, matchMany, (?==)) +import System.FilePattern (FilePattern, (?==)) import System.FilePattern.Directory (getDirectoryFilesIgnore) import UnliftIO (MonadUnliftIO, toIO, withRunInIO) diff --git a/src/Ema/Route.hs b/src/Ema/Route.hs index 5dba6d3..b72181e 100644 --- a/src/Ema/Route.hs +++ b/src/Ema/Route.hs @@ -3,52 +3,66 @@ module Ema.Route ( FileRoute (..), - htmlSlugs, routeUrl, - routeFile, + decodeUrlRoute, Slug (unSlug), decodeSlug, encodeSlug, - UrlStrategy (..), ) where -import Data.Default (def) -import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug) -import Ema.Route.UrlStrategy - ( UrlStrategy (..), - slugFileWithStrategy, - slugRelUrlWithStrategy, - ) +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug, unicodeNormalize) +import qualified Network.URI.Encode as UE +import System.FilePath (()) -- | Route to a generated file. class FileRoute route where -- | Slug path as well as the extension of the file corresponding to this -- route. - encodeRoute :: route -> ([Slug], String) + encodeFileRoute :: route -> FilePath -- | Decode a slug path into a route. The final component of the slug path -- will contain the extension if there is any. - decodeRoute :: [Slug] -> Maybe route - -htmlSlugs :: [Slug] -> ([Slug], String) -htmlSlugs = (,".html") + decodeFileRoute :: FilePath -> Maybe route -- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only. instance FileRoute () where - encodeRoute () = ([], ".html") - decodeRoute = \case - [] -> Just () + encodeFileRoute () = "index.html" + decodeFileRoute = \case + "index.html" -> Just () _ -> Nothing +-- | Decode a URL path into a route +decodeUrlRoute :: FileRoute route => Text -> Maybe route +decodeUrlRoute (toString -> s) = + decodeFileRoute s + <|> decodeFileRoute (s <> ".html") + <|> decodeFileRoute (s "index.html") + -- | 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. FileRoute r => r -> Text -routeUrl r = - slugRelUrlWithStrategy def (encodeRoute r) - -routeFile :: forall r. FileRoute r => r -> FilePath -routeFile r = - slugFileWithStrategy def (encodeRoute r) +routeUrl = + relUrlFromPath . encodeFileRoute + where + relUrlFromPath :: FilePath -> Text + relUrlFromPath fp = + case T.stripSuffix ".html" (toText fp) of + Just htmlFp -> + case nonEmpty (UE.encodeText . unicodeNormalize <$> T.splitOn "/" htmlFp) of + Nothing -> + "" + Just (removeLastIf "index" -> partsSansIndex) -> + T.intercalate "/" partsSansIndex + Nothing -> + UE.encodeText . unicodeNormalize . toText $ fp + where + removeLastIf :: Eq a => a -> NonEmpty a -> [a] + removeLastIf x xs = + if NE.last xs == x + then NE.init xs + else toList xs \ No newline at end of file diff --git a/src/Ema/Route/Slug.hs b/src/Ema/Route/Slug.hs index 214ec0d..c747207 100644 --- a/src/Ema/Route/Slug.hs +++ b/src/Ema/Route/Slug.hs @@ -31,7 +31,8 @@ instance IsString Slug where if "/" `T.isInfixOf` s then error ("Slug cannot contain a slash: " <> s) else Slug (unicodeNormalize s) - where - -- Normalize varying non-ascii strings (in filepaths / slugs) to one - -- representation, so that they can be reliably linked to. - unicodeNormalize = UT.normalize UT.NFC . toText + +-- Normalize varying non-ascii strings (in filepaths / slugs) to one +-- representation, so that they can be reliably linked to. +unicodeNormalize :: Text -> Text +unicodeNormalize = UT.normalize UT.NFC . toText diff --git a/src/Ema/Route/UrlStrategy.hs b/src/Ema/Route/UrlStrategy.hs deleted file mode 100644 index 1ab15ca..0000000 --- a/src/Ema/Route/UrlStrategy.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE QuasiQuotes #-} - -module Ema.Route.UrlStrategy where - -import Data.Default (Default, def) -import qualified Data.List.NonEmpty as NE -import qualified Data.Text as T -import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug) -import System.FilePath (joinPath) - -data UrlStrategy - = -- | URLs always end with a slash, and correspond to index.html in that folder - UrlStrategy_FolderOnly - | -- | Pretty URLs without ugly .html ext or slash-suffix - UrlStrategy_HtmlOnlySansExt - deriving (Eq, Show, Ord) - -instance Default UrlStrategy where - def = UrlStrategy_HtmlOnlySansExt - -slugRelUrlWithStrategy :: UrlStrategy -> ([Slug], String) -> Text -slugRelUrlWithStrategy strat (slugs, ".html") = - case strat of - UrlStrategy_FolderOnly -> - T.intercalate "/" (encodeSlug <$> slugs) - UrlStrategy_HtmlOnlySansExt -> - case nonEmpty slugs of - Nothing -> - "" - Just (removeLastIf (decodeSlug "index") -> slugsWithoutIndex) -> - T.intercalate "/" (encodeSlug <$> slugsWithoutIndex) - where - removeLastIf :: Eq a => a -> NonEmpty a -> [a] - removeLastIf x xs = - if NE.last xs == x - then NE.init xs - else toList xs -slugRelUrlWithStrategy _ (slugs, ext) = - T.intercalate "/" (encodeSlug <$> slugs) <> toText ext - -slugFileWithStrategy :: UrlStrategy -> ([Slug], String) -> FilePath -slugFileWithStrategy strat (slugs, ext) = - case strat of - UrlStrategy_FolderOnly -> - joinPath $ fmap (toString . unSlug) slugs <> ["index" <> ext] - UrlStrategy_HtmlOnlySansExt -> - let (term :| (reverse -> parts)) = fromMaybe ("index" :| []) $ nonEmpty (reverse $ fmap (toString . unSlug) slugs) - in joinPath $ parts <> [term <> ext] diff --git a/src/Ema/Server.hs b/src/Ema/Server.hs index b087588..0bf967d 100644 --- a/src/Ema/Server.hs +++ b/src/Ema/Server.hs @@ -9,8 +9,7 @@ import Control.Monad.Logger import Data.LVar (LVar) import qualified Data.LVar as LVar import qualified Data.Text as T -import Ema.Route (FileRoute (..)) -import qualified Ema.Route.Slug as Slug +import Ema.Route (FileRoute (..), decodeUrlRoute) import GHC.IO.Unsafe (unsafePerformIO) import NeatInterpolation (text) import qualified Network.HTTP.Types as H @@ -128,7 +127,7 @@ runServerWithWebSocketHotReload port model render = do <> show @Text err <> "

Once you fix your code this page will automatically update." routeFromPathInfo = - decodeRoute @route . fmap Slug.decodeSlug + decodeUrlRoute @route . T.intercalate "/" -- TODO: It would be good have this also get us the stack trace. unsafeCatch :: Exception e => a -> (e -> a) -> a unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f)