Switch to fourmolu; and check format in CI

.vscode/settings.json

@@ -1,5 +1,6 @@
 {
     "editor.formatOnType": true,
     "editor.formatOnSave": true,
-    "nixEnvSelector.nixFile": "${workspaceRoot}/shell.nix"
+    "nixEnvSelector.nixFile": "${workspaceRoot}/shell.nix",
+    "haskell.formattingProvider": "fourmolu"
 }

bin/format

@@ -1,6 +0,0 @@
-#!/usr/bin/env nix-shell 
-#! nix-shell ../shell.nix -i bash
-set -xe
-find src -name \*.hs | xargs ormolu -m inplace -o -XImportQualifiedPost  -o -XTypeApplications
-nixpkgs-fmt *.nix
-cabal-fmt -i *.cabal

flake.lock

@@ -31,6 +31,43 @@
         "type": "github"
       }
     },
+    "flake-utils_2": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "lint-utils": {
+      "inputs": {
+        "flake-utils": "flake-utils_2",
+        "nixpkgs": [
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1648405819,
+        "narHash": "sha256-Rv9QsHg5a3OurGxbC0Y2aERAZ0sFXYQyaxGYXdDPiZ4=",
+        "ref": "parameterized",
+        "rev": "9ba45de1fc3dbbe65c39d7d0107b99a8046a8081",
+        "revCount": 21,
+        "type": "git",
+        "url": "https://gitlab.homotopic.tech/nix/lint-utils.git"
+      },
+      "original": {
+        "ref": "parameterized",
+        "type": "git",
+        "url": "https://gitlab.homotopic.tech/nix/lint-utils.git"
+      }
+    },
     "nixpkgs": {
       "locked": {
         "lastModified": 1648219316,
@@ -51,6 +88,7 @@
       "inputs": {
         "flake-compat": "flake-compat",
         "flake-utils": "flake-utils",
+        "lint-utils": "lint-utils",
         "nixpkgs": "nixpkgs"
       }
     }

flake.nix

@@ -6,6 +6,12 @@
     flake-utils.inputs.nixpkgs.follows = "nixpkgs";
     flake-compat.url = "github:edolstra/flake-compat";
     flake-compat.flake = false;
+    lint-utils = {
+      type = "git";
+      url = "https://gitlab.homotopic.tech/nix/lint-utils.git";
+      ref = "parameterized";
+      inputs.nixpkgs.follows = "nixpkgs";
+    };
   };
   outputs = inputs@{ self, nixpkgs, flake-utils, ... }:
     flake-utils.lib.eachDefaultSystem
@@ -35,6 +41,26 @@
                     pkgs.nixpkgs-fmt
                   ]);
             };
+
+          fourmoluOpts = "-o-XTypeApplications -o-XImportQualifiedPost";
+
+          # Checks the shell script using ShellCheck
+          checkedShellScript = name: text:
+            (pkgs.writeShellApplication {
+              inherit name text;
+            }) + "/bin/${name}";
+
+          # Concat a list of Flake apps to produce a new app that runs all of them
+          # in sequence.
+          concatApps = apps:
+            {
+              type = "app";
+              program = checkedShellScript "concatApps"
+                (pkgs.lib.strings.concatMapStringsSep
+                  "\n"
+                  (app: app.program)
+                  apps);
+            };
         in
         rec {
           # Used by `nix build`
@@ -48,6 +74,22 @@
             default = emaProject false;
           };
 
+          # Used by `nix run ...`
+          apps = {
+            format = concatApps [
+              (inputs.lint-utils.apps.${system}.fourmolu fourmoluOpts)
+              inputs.lint-utils.apps.${system}.cabal-fmt
+              inputs.lint-utils.apps.${system}.nixpkgs-fmt
+            ];
+          };
+
+          # Used by `nix flake check` (but see next attribute)
+          checks = {
+            format-haskell = inputs.lint-utils.linters.${system}.fourmolu ./. fourmoluOpts;
+            format-cabal = inputs.lint-utils.linters.${system}.cabal-fmt ./.;
+            format-nix = inputs.lint-utils.linters.${system}.nixpkgs-fmt ./.;
+          };
+
         }) // {
       herculesCI.ciSystems = [ "x86_64-linux" ];
     };

fourmolu.yaml

@@ -0,0 +1,8 @@
+indentation: 2
+comma-style: leading
+record-brace-space: true 
+indent-wheres: true
+diff-friendly-import-export: true 
+respectful: true 
+haddock-style: multi-line 
+newlines-between-decls: 1 

src/Ema.hs

@@ -1,7 +1,6 @@
-module Ema
-  ( module X,
-  )
-where
+module Ema (
+  module X,
+) where
 
 import Ema.App as X
 import Ema.Asset as X
@@ -9,11 +8,11 @@ import Ema.Dynamic as X
 import Ema.Model as X
 import Ema.Route.Class as X
 import Ema.Route.Prefixed as X
-import Ema.Route.Url as X
-  ( UrlStrategy (UrlDirect, UrlPretty),
-    routeUrl,
-    routeUrlWith,
-  )
-import Ema.Server as X
-  ( emaErrorHtmlResponse,
-  )
+import Ema.Route.Url as X (
+  UrlStrategy (UrlDirect, UrlPretty),
+  routeUrl,
+  routeUrlWith,
+ )
+import Ema.Server as X (
+  emaErrorHtmlResponse,
+ )

src/Ema/App.hs

@@ -1,10 +1,9 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 
-module Ema.App
-  ( runSite,
-    runSiteWithCli,
-  )
-where
+module Ema.App (
+  runSite,
+  runSiteWithCli,
+) where
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (race_)
@@ -23,9 +22,10 @@ import Ema.Route.Class (IsRoute (RouteModel, routeEncoder))
 import Ema.Server qualified as Server
 import System.Directory (getCurrentDirectory)
 
--- | Run the given Ema site, and return the generated files.
---
--- On live-server mode, this function will never return.
+{- | Run the given Ema site, and return the generated files.
+
+ On live-server mode, this function will never return.
+-}
 runSite ::
   forall r.
   (Show r, Eq r, IsRoute r, CanRender r, HasModel r, CanGenerate r) =>
@@ -33,11 +33,12 @@ runSite ::
   IO (DSum CLI.Action Identity)
 runSite input = do
   cli <- CLI.cliAction
-  fmap snd $ runSiteWithCli @r cli input
+  snd <$> runSiteWithCli @r cli input
 
--- | Like @runSite@ but takes the CLI action
---
--- Useful if you are handling CLI arguments yourself.
+{- | Like @runSite@ but takes the CLI action
+
+ Useful if you are handling CLI arguments yourself.
+-}
 runSiteWithCli ::
   forall r.
   (Show r, Eq r, IsRoute r, CanRender r, HasModel r, CanGenerate r) =>

src/Ema/Asset.hs

@@ -1,20 +1,19 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Ema.Asset
-  ( Asset (..),
-    Format (..),
-    CanRender (..),
-    CanGenerate (..),
-  )
-where
+module Ema.Asset (
+  Asset (..),
+  Format (..),
+  CanRender (..),
+  CanGenerate (..),
+) where
 
 import Ema.Route.Class (IsRoute (RouteModel))
-import Ema.Route.Encoder
-  ( RouteEncoder,
-    leftRouteEncoder,
-    rightRouteEncoder,
-  )
+import Ema.Route.Encoder (
+  RouteEncoder,
+  leftRouteEncoder,
+  rightRouteEncoder,
+ )
 
 -- | The type of assets that can be bundled in a static site.
 data Asset a

src/Ema/CLI.hs

@@ -5,17 +5,17 @@
 module Ema.CLI where
 
 import Control.Monad.Logger (LogLevel (LevelDebug, LevelInfo))
-import Control.Monad.Logger.Extras
-  ( Logger (Logger),
-    colorize,
-    logToStdout,
-  )
+import Control.Monad.Logger.Extras (
+  Logger (Logger),
+  colorize,
+  logToStdout,
+ )
 import Data.Constraint.Extras.TH (deriveArgDict)
 import Data.Default (Default (def))
-import Data.GADT.Compare.TH
-  ( DeriveGCompare (deriveGCompare),
-    DeriveGEQ (deriveGEq),
-  )
+import Data.GADT.Compare.TH (
+  DeriveGCompare (deriveGCompare),
+  DeriveGEQ (deriveGEq),
+ )
 import Data.GADT.Show.TH (DeriveGShow (deriveGShow))
 import Data.Some (Some (..))
 import Options.Applicative hiding (action)
@@ -49,8 +49,8 @@ isLiveServer (Some (Run _)) = True
 isLiveServer _ = False
 
 data Cli = Cli
-  { action :: Some Action,
-    verbose :: Bool
+  { action :: Some Action
+  , verbose :: Bool
   }
   deriving stock (Eq, Show)
 

src/Ema/Dynamic.hs

@@ -1,39 +1,39 @@
-module Ema.Dynamic
-  ( Dynamic (Dynamic),
-  )
-where
+module Ema.Dynamic (
+  Dynamic (Dynamic),
+) where
 
 import Control.Monad.Logger (MonadLogger, logDebugNS)
 import UnliftIO (MonadUnliftIO, race_)
 import UnliftIO.Concurrent (threadDelay)
 
--- | A time-varying value
---
---  To create a Dynamic, supply the initial value along with a function that knows
---  how to update it using the given update function.
---
--- Dynamic's can be composed using Applicative.
+{- | A time-varying value
+
+  To create a Dynamic, supply the initial value along with a function that knows
+  how to update it using the given update function.
+
+ Dynamic's can be composed using Applicative.
+-}
 newtype Dynamic m a
   = Dynamic
       ( -- Initial value
-        a,
-        -- Set a new value
+        a
+      , -- Set a new value
         (a -> m ()) -> m ()
       )
 
 instance Functor (Dynamic m) where
   fmap f (Dynamic (x0, xf)) =
     Dynamic
-      ( f x0,
-        \send -> xf $ send . f
+      ( f x0
+      , \send -> xf $ send . f
       )
 
 instance (MonadUnliftIO m, MonadLogger m) => Applicative (Dynamic m) where
   pure x = Dynamic (x, \_ -> pure ())
   liftA2 f (Dynamic (x0, xf)) (Dynamic (y0, yf)) =
     Dynamic
-      ( f x0 y0,
-        \send -> do
+      ( f x0 y0
+      , \send -> do
           var <- newTVarIO (x0, y0)
           sendLock :: TMVar () <- newEmptyTMVarIO
           -- TODO: Use site name in logging?

src/Ema/Example/Common.hs

@@ -1,7 +1,6 @@
-module Ema.Example.Common
-  ( tailwindLayout,
-  )
-where
+module Ema.Example.Common (
+  tailwindLayout,
+) where
 
 import Text.Blaze.Html.Renderer.Utf8 qualified as RU
 import Text.Blaze.Html5 ((!))

src/Ema/Example/Ex01_Basic.hs

@@ -16,11 +16,11 @@ data Route
   | Route_About
   deriving stock (Show, Eq, Generic, Enum, Bounded)
   deriving anyclass
-    ( SOP.Generic,
-      SOP.HasDatatypeInfo,
-      HasModel,
-      IsRoute,
-      CanGenerate
+    ( SOP.Generic
+    , SOP.HasDatatypeInfo
+    , HasModel
+    , IsRoute
+    , CanGenerate
     )
 
 main :: IO ()

src/Ema/Example/Ex02_Store.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE UndecidableInstances #-}
 
--- | A simple web store for products
---
--- TODO: rewrite this to load store.json and display that, with individual page for books too.
+{- | A simple web store for products
+
+ TODO: rewrite this to load store.json and display that, with individual page for books too.
+-}
 module Ema.Example.Ex02_Store where
 
 import Data.Text qualified as T
@@ -17,8 +18,8 @@ import Text.Blaze.Html5 qualified as H
 import Text.Blaze.Html5.Attributes qualified as A
 
 data Model = Model
-  { modelProducts :: [Text],
-    modelCategories :: [Text]
+  { modelProducts :: [Text]
+  , modelCategories :: [Text]
   }
 
 data Route

src/Ema/Example/Ex03_Clock.hs

@@ -4,12 +4,13 @@
 
 {-# HLINT ignore "Use camelCase" #-}
 
--- | A very simple site with routes, but based on dynamically changing values
---
--- The current time is computed in the server every second, and the resultant
--- generated HTML is automatically updated on the browser. This is only a demo;
--- usually we render HTML based on files on disk or something accessible outside
--- of the browser. More advanced examples will demonstrate that.
+{- | A very simple site with routes, but based on dynamically changing values
+
+ The current time is computed in the server every second, and the resultant
+ generated HTML is automatically updated on the browser. This is only a demo;
+ usually we render HTML based on files on disk or something accessible outside
+ of the browser. More advanced examples will demonstrate that.
+-}
 module Ema.Example.Ex03_Clock where
 
 import Control.Concurrent (threadDelay)

src/Ema/Generate.hs

@@ -40,14 +40,14 @@ generateSite dest model = do
 
 generate ::
   forall r m.
-  ( MonadIO m,
-    MonadUnliftIO m,
-    MonadLoggerIO m,
-    HasCallStack,
-    Eq r,
-    Show r,
-    CanRender r,
-    CanGenerate r
+  ( MonadIO m
+  , MonadUnliftIO m
+  , MonadLoggerIO m
+  , HasCallStack
+  , Eq r
+  , Show r
+  , CanRender r
+  , CanGenerate r
   ) =>
   FilePath ->
   RouteEncoder (RouteModel r) r ->
@@ -90,8 +90,9 @@ generate dest enc model render = do
   noBirdbrainedJekyll dest
   pure paths
 
--- | Disable birdbrained hacks from GitHub to disable surprises like,
--- https://github.com/jekyll/jekyll/issues/55
+{- | Disable birdbrained hacks from GitHub to disable surprises like,
+ https://github.com/jekyll/jekyll/issues/55
+-}
 noBirdbrainedJekyll :: (MonadIO m, MonadLoggerIO m) => FilePath -> m ()
 noBirdbrainedJekyll dest = do
   let nojekyll = dest </> ".nojekyll"
@@ -106,10 +107,10 @@ newtype StaticAssetMissing = StaticAssetMissing FilePath
   deriving anyclass (Exception)
 
 copyDirRecursively ::
-  ( MonadIO m,
-    MonadUnliftIO m,
-    MonadLoggerIO m,
-    HasCallStack
+  ( MonadIO m
+  , MonadUnliftIO m
+  , MonadLoggerIO m
+  , HasCallStack
   ) =>
   -- | Source file path relative to CWD
   FilePath ->

src/Ema/Model.hs

@@ -1,10 +1,9 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Ema.Model
-  ( HasModel (..),
-  )
-where
+module Ema.Model (
+  HasModel (..),
+) where
 
 import Control.Monad.Logger (MonadLoggerIO)
 import Data.SOP
@@ -37,10 +36,10 @@ class IsRoute r => HasModel r where
     m (Dynamic m (RouteModel r))
   default modelDynamic ::
     forall m.
-    ( MonadIO m,
-      MonadUnliftIO m,
-      MonadLoggerIO m,
-      RouteModel r ~ NP I '[]
+    ( MonadIO m
+    , MonadUnliftIO m
+    , MonadLoggerIO m
+    , RouteModel r ~ NP I '[]
     ) =>
     Some CLI.Action ->
     RouteEncoder (RouteModel r) r ->

src/Ema/Route/Class.hs

@@ -3,46 +3,45 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
-module Ema.Route.Class
-  ( IsRoute (RouteModel, routeEncoder),
-    gRouteEncoder,
-    SingleModelRoute (..),
-    ShowReadable (ShowReadable),
-    Stringable (Stringable),
+module Ema.Route.Class (
+  IsRoute (RouteModel, routeEncoder),
+  gRouteEncoder,
+  SingleModelRoute (..),
+  ShowReadable (ShowReadable),
+  Stringable (Stringable),
 
-    -- * Sub routes
-    innerRouteEncoder,
-    innerModel,
-  )
-where
+  -- * Sub routes
+  innerRouteEncoder,
+  innerModel,
+) where
 
 import Data.List ((!!))
 import Ema.Route.Encoder
 import Ema.Route.Generic
-import GHC.TypeLits
-  ( ErrorMessage (ShowType, Text, (:$$:)),
-    TypeError,
-  )
+import GHC.TypeLits (
+  ErrorMessage (ShowType, Text, (:$$:)),
+  TypeError,
+ )
 import Generics.SOP
-import Optics.Core
-  ( A_Prism,
-    Is,
-    Iso',
-    NoIx,
-    Optic',
-    coercedTo,
-    equality,
-    iso,
-    prism',
-    review,
-    view,
-    (%),
-  )
-import System.FilePath
-  ( joinPath,
-    splitDirectories,
-    (</>),
-  )
+import Optics.Core (
+  A_Prism,
+  Is,
+  Iso',
+  NoIx,
+  Optic',
+  coercedTo,
+  equality,
+  iso,
+  prism',
+  review,
+  view,
+  (%),
+ )
+import System.FilePath (
+  joinPath,
+  splitDirectories,
+  (</>),
+ )
 import Prelude hiding (All, Generic)
 
 class IsRoute r where
@@ -50,24 +49,26 @@ class IsRoute r where
   type RouteModel r = NP I (GRouteModel (Code r))
   routeEncoder :: RouteEncoder (RouteModel r) r
   default routeEncoder ::
-    ( Generic r,
-      ms ~ GRouteModel (Code r),
-      All2 IsRoute (Code r),
-      All (IsRouteProd ms) (Code r),
-      HasDatatypeInfo r,
-      RouteModel r ~ NP I ms
+    ( Generic r
+    , ms ~ GRouteModel (Code r)
+    , All2 IsRoute (Code r)
+    , All (IsRouteProd ms) (Code r)
+    , HasDatatypeInfo r
+    , RouteModel r ~ NP I ms
     ) =>
     RouteEncoder (RouteModel r) r
   routeEncoder = gRouteEncoder
 
--- | DerivingVia repr for routes that use a single model for all inner routes.
---
--- This uses NPConst to support >1 constr with same model.
+{- | DerivingVia repr for routes that use a single model for all inner routes.
+
+ This uses NPConst to support >1 constr with same model.
+-}
 newtype SingleModelRoute (m :: Type) r = SingleModelRoute {unSingleModelRoute :: r}
 
--- | Like `NP` but all elements are the same.
---
--- Each of `xs` is equivalent to `a`.
+{- | Like `NP` but all elements are the same.
+
+ Each of `xs` is equivalent to `a`.
+-}
 class NPConst (f :: k -> Type) (xs :: [k]) (a :: k) where
   npConstFrom :: f a -> NP f xs
 
@@ -81,11 +82,11 @@ instance (NPConst f xs x) => NPConst f (x ': xs) x where
   npConstFrom x = x :* npConstFrom @_ @f @xs @x x
 
 instance
-  ( GRouteModel (Code r) ~ ms,
-    NPConst I ms m,
-    HasDatatypeInfo r,
-    All2 IsRoute (Code r),
-    All (IsRouteProd ms) (Code r)
+  ( GRouteModel (Code r) ~ ms
+  , NPConst I ms m
+  , HasDatatypeInfo r
+  , All2 IsRoute (Code r)
+  , All (IsRouteProd ms) (Code r)
   ) =>
   IsRoute (SingleModelRoute m r)
   where
@@ -124,19 +125,16 @@ type family GRouteModel (xss :: [[Type]]) :: [Type] where
   GRouteModel ('[] ': xss) = GRouteModel xss
   GRouteModel ('[x] ': xss) = RouteModel x `UnitCons` GRouteModel xss
 -- TODO: reuse from below
-  GRouteModel (_ ': _) = TypeError ('Text "More than 1 route product")
+  GRouteModel (_ ': _) = TypeError ( 'Text "More than 1 route product")
 
 type family UnitCons x xs where
   UnitCons () xs = xs
   UnitCons (NP I '[]) xs = xs
   UnitCons x xs = x ': xs
 
--- | TODO: Can this be simplified?
-class (xs :: [Type]) `Contains` (x :: Type) where
-  -- | A partial iso into/from NP, given a member type.
-  --
-  -- When creating the outer NP structure, rest of the members will be
-  -- undefined.
+-- TODO: Can this be simplified?
+class Contains (xs :: [Type]) (x :: Type) where
+  -- | A partial iso into/from NP, given a member type. When creating the outer NP structure, rest of the members will be `undefined`.
   npIso :: Iso' (NP I xs) x
 
 there :: Iso' (NP I (x ': xs)) (NP I xs)
@@ -158,7 +156,7 @@ instance {-# OVERLAPPING #-} Contains '[] (NP I '[]) where
 instance {-# OVERLAPPING #-} Contains xs () => Contains (x ': xs) () where
   npIso = there % npIso
 
-instance (TypeError ('Text "The type " ':$$: 'ShowType x ':$$: 'Text " does not exist in n-ary product")) => Contains '[] x where
+instance (TypeError ( 'Text "The type " ':$$: 'ShowType x ':$$: 'Text " does not exist in n-ary product")) => Contains '[] x where
   npIso = iso willNotBeUsed willNotBeUsed
 
 instance {-# OVERLAPPING #-} Contains (x ': xs) x where
@@ -167,8 +165,9 @@ instance {-# OVERLAPPING #-} Contains (x ': xs) x where
 instance {-# OVERLAPPABLE #-} Contains xs x => Contains (x' ': xs) x where
   npIso = there % npIso
 
--- | Extract the inner RouteEncoder.
--- TODO: avoid having to specify Prism
+{- | Extract the inner RouteEncoder.
+ TODO: avoid having to specify Prism
+-}
 innerRouteEncoder ::
   forall m o i (ms :: [Type]) pf.
   pf `Is` A_Prism =>
@@ -186,11 +185,11 @@ innerModel = view npIso
 -- TODO: Can I simplify this using `prefixRouteEncoder`?
 gRouteEncoder ::
   forall r ms.
-  ( Generic r,
-    ms ~ GRouteModel (Code r),
-    All2 IsRoute (Code r),
-    All (IsRouteProd ms) (Code r),
-    HasDatatypeInfo r
+  ( Generic r
+  , ms ~ GRouteModel (Code r)
+  , All2 IsRoute (Code r)
+  , All (IsRouteProd ms) (Code r)
+  , HasDatatypeInfo r
   ) =>
   RouteEncoder (NP I ms) r
 gRouteEncoder =
@@ -199,11 +198,11 @@ gRouteEncoder =
 
 gEncodeRoute ::
   forall r ms.
-  ( Generic r,
-    ms ~ GRouteModel (Code r),
-    All2 IsRoute (Code r),
-    All (IsRouteProd ms) (Code r),
-    HasDatatypeInfo r
+  ( Generic r
+  , ms ~ GRouteModel (Code r)
+  , All2 IsRoute (Code r)
+  , All (IsRouteProd ms) (Code r)
+  , HasDatatypeInfo r
   ) =>
   NP I ms ->
   r ->
@@ -234,11 +233,11 @@ instance (All (IsRouteIn ms) xs, HCollapseMaybe NP xs) => IsRouteProd ms xs
 
 gDecodeRoute ::
   forall r ms.
-  ( Generic r,
-    ms ~ GRouteModel (Code r),
-    All2 IsRoute (Code r),
-    All (IsRouteProd ms) (Code r),
-    HasDatatypeInfo r
+  ( Generic r
+  , ms ~ GRouteModel (Code r)
+  , All2 IsRoute (Code r)
+  , All (IsRouteProd ms) (Code r)
+  , HasDatatypeInfo r
   ) =>
   NP I ms ->
   FilePath ->

src/Ema/Route/CtxPrism.hs

@@ -1,34 +1,34 @@
-module Ema.Route.CtxPrism
-  ( -- * Type
-    CtxPrism,
+module Ema.Route.CtxPrism (
+  -- * Type
+  CtxPrism,
 
-    -- * Construction
-    fromPrism,
+  -- * Construction
+  fromPrism,
 
-    -- * Conversion
-    cpreview,
-    creview,
+  -- * Conversion
+  cpreview,
+  creview,
 
-    -- * Functor
-    cpmap,
+  -- * Functor
+  cpmap,
 
-    -- * Law checks
-    ctxPrismIsLawfulFor,
-  )
-where
+  -- * Law checks
+  ctxPrismIsLawfulFor,
+) where
 
 import Control.Monad.Writer (Writer, tell)
-import Optics.Core
-  ( Prism',
-    preview,
-    prism',
-    review,
-    (%),
-  )
+import Optics.Core (
+  Prism',
+  preview,
+  prism',
+  review,
+  (%),
+ )
 
--- | A `Prism` with a context
--- This can't actually be a prism due to coercion problems. Use `toPrism` & `fromPrism`.
--- See https://stackoverflow.com/q/71489589/55246
+{- | A `Prism` with a context
+ This can't actually be a prism due to coercion problems. Use `toPrism` & `fromPrism`.
+ See https://stackoverflow.com/q/71489589/55246
+-}
 type CtxPrism ctx s a =
   -- FIXME: ought to be `ctx -> Prism' s a`
   ctx -> (a -> s, s -> Maybe a)

src/Ema/Route/Encoder.hs

@@ -3,28 +3,29 @@ module Ema.Route.Encoder where
 
 import Control.Monad.Writer (Writer)
 import Data.Text qualified as T
-import Ema.Route.CtxPrism
-  ( CtxPrism,
-    cpmap,
-    cpreview,
-    creview,
-    ctxPrismIsLawfulFor,
-    fromPrism,
-  )
-import Optics.Core
-  ( A_Prism,
-    Is,
-    NoIx,
-    Optic',
-    Prism',
-    castOptic,
-    equality,
-    iso,
-    prism',
-  )
+import Ema.Route.CtxPrism (
+  CtxPrism,
+  cpmap,
+  cpreview,
+  creview,
+  ctxPrismIsLawfulFor,
+  fromPrism,
+ )
+import Optics.Core (
+  A_Prism,
+  Is,
+  NoIx,
+  Optic',
+  Prism',
+  castOptic,
+  equality,
+  iso,
+  prism',
+ )
 
--- | An encoder cum decoder that knows how to convert routes to and from
--- filepaths. The conversion depends on the context `a`.
+{- | An encoder cum decoder that knows how to convert routes to and from
+ filepaths. The conversion depends on the context `a`.
+-}
 newtype RouteEncoder a r = RouteEncoder (CtxPrism a FilePath r)
 
 mapRouteEncoder ::
@@ -108,8 +109,8 @@ mergeRouteEncoder enc1 enc2 =
       )
       ( \fp ->
           asum
-            [ Left <$> decodeRoute enc1 (fst m) fp,
-              Right <$> decodeRoute enc2 (snd m) fp
+            [ Left <$> decodeRoute enc1 (fst m) fp
+            , Right <$> decodeRoute enc2 (snd m) fp
             ]
       )
 

src/Ema/Route/Generic.hs

@@ -7,10 +7,10 @@ module Ema.Route.Generic where
 
 import Data.SOP.Constraint (SListIN)
 import Data.Text qualified as T
-import GHC.TypeLits
-  ( ErrorMessage (Text),
-    TypeError,
-  )
+import GHC.TypeLits (
+  ErrorMessage (Text),
+  TypeError,
+ )
 import Generics.SOP
 import Prelude hiding (All)
 
@@ -24,7 +24,7 @@ instance HCollapseMaybe NP '[] where
 instance HCollapseMaybe NP '[p] where
   hcollapseMaybe (K x :* Nil) = Just x
 
-instance (ps ~ TypeError ('Text "Expected at most 1 product")) => HCollapseMaybe NP (p ': p1 ': ps) where
+instance (ps ~ TypeError ( 'Text "Expected at most 1 product")) => HCollapseMaybe NP (p ': p1 ': ps) where
   hcollapseMaybe _ = Nothing -- Unreachable, due to TypeError
 
 datatypeCtors :: forall a. HasDatatypeInfo a => NP ConstructorInfo (Code a)

src/Ema/Route/Prefixed.hs

@@ -1,20 +1,19 @@
-module Ema.Route.Prefixed
-  ( PrefixedRoute (PrefixedRoute, unPrefixedRoute),
-    prefixRouteEncoder,
-  )
-where
+module Ema.Route.Prefixed (
+  PrefixedRoute (PrefixedRoute, unPrefixedRoute),
+  prefixRouteEncoder,
+) where
 
 import Data.Text qualified as T
 import Ema.Asset (CanGenerate (generatableRoutes), CanRender (..))
-import Ema.Model
-  ( HasModel (ModelInput, modelDynamic),
-  )
+import Ema.Model (
+  HasModel (ModelInput, modelDynamic),
+ )
 import Ema.Route.Class (IsRoute (..))
-import Ema.Route.Encoder
-  ( RouteEncoder,
-    chainRouteEncoder,
-    mapRouteEncoder,
-  )
+import Ema.Route.Encoder (
+  RouteEncoder,
+  chainRouteEncoder,
+  mapRouteEncoder,
+ )
 import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
 import Optics.Core (coercedTo, prism')
 import System.FilePath ((</>))

src/Ema/Route/Url.hs

@@ -1,13 +1,12 @@
 {-# LANGUAGE InstanceSigs #-}
 
-module Ema.Route.Url
-  ( -- * Create URL from route
-    routeUrl,
-    routeUrlWith,
-    UrlStrategy (..),
-    urlToFilePath,
-  )
-where
+module Ema.Route.Url (
+  -- * Create URL from route
+  routeUrl,
+  routeUrlWith,
+  UrlStrategy (..),
+  urlToFilePath,
+) where
 
 import Data.Aeson (FromJSON (parseJSON), Value)
 import Data.Aeson.Types (Parser)
@@ -16,10 +15,11 @@ import Data.Text qualified as T
 import Ema.Route.Encoder (RouteEncoder, encodeRoute)
 import Network.URI.Slug qualified as Slug
 
--- | 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 `<base>` URL in your HTML head element.
+{- | 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 `<base>` URL in your HTML head element.
+-}
 routeUrlWith :: UrlStrategy -> RouteEncoder a r -> a -> r -> Text
 routeUrlWith urlStrategy enc model =
   relUrlFromPath . encodeRoute enc model

src/Ema/Server.hs

@@ -14,11 +14,11 @@ import Data.Text qualified as T
 import Ema.Asset
 import Ema.CLI
 import Ema.Route.Class
-import Ema.Route.Encoder
-  ( checkRouteEncoderForSingleRoute,
-    decodeRoute,
-    encodeRoute,
-  )
+import Ema.Route.Encoder (
+  checkRouteEncoderForSingleRoute,
+  decodeRoute,
+  encodeRoute,
+ )
 import Ema.Route.Url (urlToFilePath)
 import GHC.IO.Unsafe (unsafePerformIO)
 import NeatInterpolation (text)
@@ -35,13 +35,13 @@ import UnliftIO (MonadUnliftIO)
 
 runServerWithWebSocketHotReload ::
   forall r m.
-  ( Show r,
-    MonadIO m,
-    MonadUnliftIO m,
-    MonadLoggerIO m,
-    Eq r,
-    IsRoute r,
-    CanRender r
+  ( Show r
+  , MonadIO m
+  , MonadUnliftIO m
+  , MonadLoggerIO m
+  , Eq r
+  , IsRoute r
+  , CanRender r
   ) =>
   Host ->
   Port ->
@@ -208,8 +208,9 @@ mkHtmlErrorMsg s =
       <> s
       <> "</div><p>Once you fix the source of the error, this page will automatically refresh.</body>"
 
--- | Return the equivalent of WAI's @pathInfo@, from the raw path string
--- (`document.location.pathname`) the browser sends us.
+{- | Return the equivalent of WAI's @pathInfo@, from the raw path string
+ (`document.location.pathname`) the browser sends us.
+-}
 pathInfoFromWsMsg :: Text -> [Text]
 pathInfoFromWsMsg =
   filter (/= "") . T.splitOn "/" . T.drop 1
@@ -218,9 +219,9 @@ decodeRouteNothingMsg :: Text
 decodeRouteNothingMsg = "Ema: 404 (decodeRoute returned Nothing)"
 
 data BadRouteEncoding r = BadRouteEncoding
-  { _bre_candidates :: [(FilePath, [Text])],
-    _bre_decodedRoute :: r,
-    _bre_routeEncoded :: FilePath
+  { _bre_candidates :: [(FilePath, [Text])]
+  , _bre_decodedRoute :: r
+  , _bre_routeEncoded :: FilePath
   }
   deriving stock (Show)