diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..9cfde2c --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,5 @@ +# HLint configuration for roux-server. +# Suppress noise that can't be cleanly fixed (e.g. blaze-html lambda patterns +# where the suggested eta-reduced form has precedence issues). + +- ignore: {name: "Avoid lambda"} diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs index 7047c39..93cd114 100644 --- a/src/Roux/Html.hs +++ b/src/Roux/Html.hs @@ -18,7 +18,7 @@ import Control.Monad (unless) import Data.ByteString.Lazy (ByteString) import Data.Function ((&)) import qualified Data.List.NonEmpty as NE -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, fromMaybe) import Data.Ratio (denominator, numerator) import Data.Text (Text) import qualified Data.Text as T @@ -46,7 +46,7 @@ showQuantity q = 1 -> T.pack (show (numerator amt)) _ -> T.pack (show (toDouble amt)) prefix = if quantityFixed q then "=" else "" - unit = maybe "" (\u -> "%" <> u) (quantityUnit q) + unit = maybe "" ("%" <>) (quantityUnit q) in prefix <> amount <> unit -- --------------------------------------------------------------------------- @@ -93,7 +93,7 @@ indexPage recipes = let bad = filter (isLeft . Idx.riRecipe) recipes unless (null bad) $ do H.h3 "Unparseable recipes" - H.ul $ mapM_ (\r -> H.li $ H.toHtml (Idx.riTitle r)) bad + H.ul $ mapM_ (H.li . H.toHtml . Idx.riTitle) bad -- | Render a single recipe link on the index page. recipeItem :: FilePath -> Html @@ -134,10 +134,7 @@ renderRecipe recipe = do -- | Extract display title from recipe metadata or fallback. titleText :: Recipe -> Text -titleText recipe = - case metaTitle (recipeMetadata recipe) of - Just t -> t - Nothing -> "Untitled Recipe" +titleText recipe = fromMaybe "Untitled Recipe" (metaTitle (recipeMetadata recipe)) -- --------------------------------------------------------------------------- -- Metadata @@ -179,7 +176,7 @@ showDuration d = amount = case denominator amt of 1 -> T.pack (show (numerator amt)) _ -> T.pack (show (toDouble amt)) - unit = maybe "" Prelude.id (durationUnit d) + unit = fromMaybe "" (durationUnit d) in T.strip (amount <> " " <> unit) -- | Roughly convert Rational to Double for display. diff --git a/src/Roux/Parser.hs b/src/Roux/Parser.hs index 493760d..e1f5085 100644 --- a/src/Roux/Parser.hs +++ b/src/Roux/Parser.hs @@ -357,20 +357,18 @@ buildRecipe items = groupSections :: [RawBlock] -> [Section] groupSections [] = [] groupSections items = - case span (not . isSectionHeader) items of + case break isSectionHeader items of -- No section header: everything goes into an unnamed section (body, []) -> [Section Nothing (makeNonEmpty (map rawToBody body))] -- Items before the first header → unnamed section, then named (before, (RawSectionHeader name) : rest) -> let pre = - if null before - then [] - else [Section Nothing (makeNonEmpty (map rawToBody before))] + [Section Nothing (makeNonEmpty (map rawToBody before)) + | not (null before) + ] named = collectNamedSection name rest in pre ++ named - -- Unreachable: 'span' never returns a non-header as the first item - -- of the second component, but GHC doesn't know that. _ -> error "groupSections: impossible" -- | Is this block a section header? @@ -381,7 +379,7 @@ isSectionHeader _ = False -- | Collect a named section: from the header to the next header (or end). collectNamedSection :: Text -> [RawBlock] -> [Section] collectNamedSection name items = - case span (not . isSectionHeader) items of + case break isSectionHeader items of (body, []) -> [Section (Just name) (makeNonEmpty (map rawToBody body))] (body, (RawSectionHeader nextName) : rest) -> diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 812f5bb..3128945 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -68,11 +68,10 @@ urlDecodePath = Html.urlDecode -- | Build a 200 HTML response. htmlResponse :: ByteString -> Wai.Response -htmlResponse body = +htmlResponse = Wai.responseLBS HTTP.status200 [("Content-Type", "text/html; charset=utf-8")] - body -- | 404 response. notFound :: Wai.Response