Use fourmolu instead of stylish-haskell

.stylish-haskell.yaml

@@ -1,481 +0,0 @@
-# stylish-haskell configuration file
-# ==================================
-
-# The stylish-haskell tool is mainly configured by specifying steps. These steps
-# are a list, so they have an order, and one specific step may appear more than
-# once (if needed). Each file is processed by these steps in the given order.
-steps:
-  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
-  # by default.
-  # - unicode_syntax:
-  #     # In order to make this work, we also need to insert the UnicodeSyntax
-  #     # language pragma. If this flag is set to true, we insert it when it's
-  #     # not already present. You may want to disable it if you configure
-  #     # language extensions using some other method than pragmas. Default:
-  #     # true.
-  #     add_language_pragma: true
-
-  # Format module header
-  #
-  # Currently, this option is not configurable and will format all exports and
-  # module declarations to minimize diffs
-  #
-  # - module_header:
-  #     # How many spaces use for indentation in the module header.
-  #     indent: 4
-  #
-  #     # Should export lists be sorted?  Sorting is only performed within the
-  #     # export section, as delineated by Haddock comments.
-  #     sort: true
-  #
-  #     # See `separate_lists` for the `imports` step.
-  #     separate_lists: true
-  #
-  #     # When to break the "where".
-  #     # Possible values:
-  #     # - exports: only break when there is an explicit export list.
-  #     # - single: only break when the export list counts more than one export.
-  #     # - inline: only break when the export list is too long. This is
-  #     #   determined by the `columns` setting. Not applicable when the export
-  #     #   list contains comments as newlines will be required.
-  #     # - always: always break before the "where".
-  #     break_where: exports
-  #
-  #     # Where to put open bracket
-  #     # Possible values:
-  #     # - same_line: put open bracket on the same line as the module name, before the
-  #     #              comment of the module
-  #     # - next_line: put open bracket on the next line, after module comment
-  #     open_bracket: next_line
-
-  # Format record definitions. This is disabled by default.
-  #
-  # You can control the layout of record fields. The only rules that can't be configured
-  # are these:
-  #
-  # - "|" is always aligned with "="
-  # - "," in fields is always aligned with "{"
-  # - "}" is likewise always aligned with "{"
-  #
-  # - records:
-  #     # How to format equals sign between type constructor and data constructor.
-  #     # Possible values:
-  #     # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the next line.
-  #     equals: "indent 2"
-  #
-  #     # How to format first field of each record constructor.
-  #     # Possible values:
-  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
-  #     first_field: "indent 2"
-  #
-  #     # How many spaces to insert between the column with "," and the beginning of the comment in the next line.
-  #     field_comment: 2
-  #
-  #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
-  #     deriving: 2
-  #
-  #     # How many spaces to insert before "via" clause counted from indentation of deriving clause
-  #     # Possible values:
-  #     # - "same_line" -- "via" part goes on the same line as "deriving" keyword.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.
-  #     via: "indent 2"
-  #
-  #     # Sort typeclass names in the "deriving" list alphabetically.
-  #     sort_deriving: true
-  #
-  #     # Whether or not to break enums onto several lines
-  #     #
-  #     # Default: false
-  #     break_enums: false
-  #
-  #     # Whether or not to break single constructor data types before `=` sign
-  #     #
-  #     # Default: true
-  #     break_single_constructors: true
-  #
-  #     # Whether or not to curry constraints on function.
-  #     #
-  #     # E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
-  #     #
-  #     # Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
-  #     #
-  #     # Default: false
-  #     curried_context: false
-
-  # Align the right hand side of some elements.  This is quite conservative
-  # and only applies to statements where each element occupies a single
-  # line.
-  # Possible values:
-  # - always - Always align statements.
-  # - adjacent - Align statements that are on adjacent lines in groups.
-  # - never - Never align statements.
-  # All default to always.
-  - simple_align:
-      cases: always
-      top_level_patterns: always
-      records: always
-      multi_way_if: always
-
-  # Import cleanup
-  - imports:
-      # There are different ways we can align names and lists.
-      #
-      # - global: Align the import names and import list throughout the entire
-      #   file.
-      #
-      # - file: Like global, but don't add padding when there are no qualified
-      #   imports in the file.
-      #
-      # - group: Only align the imports per group (a group is formed by adjacent
-      #   import lines).
-      #
-      # - none: Do not perform any alignment.
-      #
-      # Default: global.
-      align: none
-
-      # The following options affect only import list alignment.
-      #
-      # List align has following options:
-      #
-      # - after_alias: Import list is aligned with end of import including
-      #   'as' and 'hiding' keywords.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                          init, last, length)
-      #
-      # - with_alias: Import list is aligned with start of alias or hiding.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                 init, last, length)
-      #
-      # - with_module_name: Import list is aligned `list_padding` spaces after
-      #   the module name.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #                          init, last, length)
-      #
-      #   This is mainly intended for use with `pad_module_names: false`.
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, head,
-      #                          init, last, length, scanl, scanr, take, drop,
-      #                          sort, nub)
-      #
-      # - new_line: Import list starts always on new line.
-      #
-      #   > import qualified Data.List      as List
-      #   >     (concat, foldl, foldr, head, init, last, length)
-      #
-      # - repeat: Repeat the module name to align the import list.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head)
-      #   > import qualified Data.List      as List (init, last, length)
-      #
-      # Default: after_alias
-      list_align: after_alias
-
-      # Right-pad the module names to align imports in a group:
-      #
-      # - true: a little more readable
-      #
-      #   > import qualified Data.List       as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # - false: diff-safe
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, init,
-      #   >                                     last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # Default: true
-      pad_module_names: true
-
-      # Long list align style takes effect when import is too long. This is
-      # determined by 'columns' setting.
-      #
-      # - inline: This option will put as much specs on same line as possible.
-      #
-      # - new_line: Import list will start on new line.
-      #
-      # - new_line_multiline: Import list will start on new line when it's
-      #   short enough to fit to single line. Otherwise it'll be multiline.
-      #
-      # - multiline: One line per import list entry.
-      #   Type with constructor list acts like single import.
-      #
-      #   > import qualified Data.Map as M
-      #   >     ( empty
-      #   >     , singleton
-      #   >     , ...
-      #   >     , delete
-      #   >     )
-      #
-      # Default: inline
-      long_list_align: multiline
-
-      # Align empty list (importing instances)
-      #
-      # Empty list align has following options
-      #
-      # - inherit: inherit list_align setting
-      #
-      # - right_after: () is right after the module name:
-      #
-      #   > import Vector.Instances ()
-      #
-      # Default: inherit
-      empty_list_align: inherit
-
-      # List padding determines indentation of import list on lines after import.
-      # This option affects 'long_list_align'.
-      #
-      # - <integer>: constant value
-      #
-      # - module_name: align under start of module name.
-      #   Useful for 'file' and 'group' align settings.
-      #
-      # Default: 4
-      list_padding: 4
-
-      # Separate lists option affects formatting of import list for type
-      # or class. The only difference is single space between type and list
-      # of constructors, selectors and class functions.
-      #
-      # - true: There is single space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
-      #
-      # - false: There is no space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
-      #
-      # Default: true
-      separate_lists: true
-
-      # Space surround option affects formatting of import lists on a single
-      # line. The only difference is single space after the initial
-      # parenthesis and a single space before the terminal parenthesis.
-      #
-      # - true: There is single space associated with the enclosing
-      #   parenthesis.
-      #
-      #   > import Data.Foo ( foo )
-      #
-      # - false: There is no space associated with the enclosing parenthesis
-      #
-      #   > import Data.Foo (foo)
-      #
-      # Default: false
-      space_surround: false
-
-      # Post qualify option moves any qualifies found in import declarations
-      # to the end of the declaration. This also adjust padding for any
-      # unqualified import declarations.
-      #
-      # - true: Qualified as <module name> is moved to the end of the
-      #   declaration.
-      #
-      #   > import Data.Bar
-      #   > import Data.Foo qualified as F
-      #
-      # - false: Qualified remains in the default location and unqualified
-      #   imports are padded to align with qualified imports.
-      #
-      #   > import           Data.Bar
-      #   > import qualified Data.Foo as F
-      #
-      # Default: false
-      post_qualify: false
-
-      # Automatically group imports based on their module names, with
-      # a blank line separating each group. Groups are ordered in
-      # alphabetical order.
-      #
-      # By default, this groups by the first part of each module's
-      # name (Control.* will be grouped together, Data.*... etc), but
-      # this can be configured with the group_patterns setting.
-      #
-      # When enabled, this rewrites existing blank lines and groups.
-      #
-      # - true: Group imports by the first part of the module name.
-      #
-      #   > import Control.Applicative
-      #   > import Control.Monad
-      #   > import Control.Monad.MonadError
-      #   >
-      #   > import Data.Functor
-      #
-      # - false: Keep import groups as-is (still sorting and
-      #   formatting the imports within each group)
-      #
-      #   > import Control.Monad
-      #   > import Data.Functor
-      #   >
-      #   > import Control.Applicative
-      #   > import Control.Monad.MonadError
-      #
-      # Default: false
-      group_imports: false
-
-      # A list of rules specifying how to group modules and how to
-      # order the groups.
-      #
-      # Each rule has a match field; the rule only applies to module
-      # names matched by this pattern. Patterns are POSIX extended
-      # regular expressions; see the documentation of Text.Regex.TDFA
-      # for details:
-      # https://hackage.haskell.org/package/regex-tdfa-1.3.1.2/docs/Text-Regex-TDFA.html
-      #
-      # Rules are processed in order, so only the *first* rule that
-      # matches a specific module will apply. Any module names that do
-      # not match a single rule will be put into a single group at the
-      # end of the import block.
-      #
-      # Example: group MyApp modules first, with everything else in
-      # one group at the end.
-      #
-      #  group_rules:
-      #    - match: "^MyApp\\>"
-      #
-      #  > import MyApp
-      #  > import MyApp.Foo
-      #  >
-      #  > import Control.Monad
-      #  > import MyApps
-      #  > import Test.MyApp
-      #
-      # A rule can also optionally have a sub_group pattern. Imports
-      # that match the rule will be broken up into further groups by
-      # the part of the module name matched by the sub_group pattern.
-      #
-      # Example: group MyApp modules first, then everything else
-      # sub-grouped by the first part of the module name.
-      #
-      #  group_rules:
-      #    - match: "^MyApp\\>"
-      #    - match: "."
-      #      sub_group: "^[^.]+"
-      #
-      #  > import MyApp
-      #  > import MyApp.Foo
-      #  >
-      #  > import Control.Applicative
-      #  > import Control.Monad
-      #  >
-      #  > import Data.Map
-      #
-      # A pattern only needs to match part of the module name, which
-      # could be in the middle. You can use ^pattern to anchor to the
-      # beginning of the module name, pattern$ to anchor to the end
-      # and ^pattern$ to force a full match. Example:
-      #
-      #  - "Test\\." would match "Test.Foo" and "Foo.Test.Lib"
-      #  - "^Test\\." would match "Test.Foo" but not "Foo.Test.Lib"
-      #  - "\\.Test$" would match "Foo.Test" but not "Foo.Test.Lib"
-      #  - "^Test$" would *only* match "Test"
-      #
-      # You can use \\< and \\> to anchor against the beginning and
-      # end of words, respectively. For example:
-      #
-      #  - "^Test\\." would match "Test.Foo" but not "Test" or "Tests"
-      #  - "^Test\\>" would match "Test.Foo" and "Test", but not
-      #    "Tests"
-      #
-      # The default is a single rule that matches everything and
-      # sub-groups based on the first component of the module name.
-      #
-      # Default: [{ "match" : ".*", "sub_group": "^[^.]+" }]
-      group_rules:
-        - match: ".*"
-          sub_group: "^[^.]+"
-
-  # Language pragmas
-  - language_pragmas:
-      # We can generate different styles of language pragma lists.
-      #
-      # - vertical: Vertical-spaced language pragmas, one per line.
-      #
-      # - compact: A more compact style.
-      #
-      # - compact_line: Similar to compact, but wrap each line with
-      #   `{-# LANGUAGE #-}'.
-      #
-      # - vertical_compact: Similar to vertical, but use only one language pragma.
-      #
-      # Default: vertical.
-      style: vertical
-
-      # Align affects alignment of closing pragma brackets.
-      #
-      # - true: Brackets are aligned in same column.
-      #
-      # - false: Brackets are not aligned together. There is only one space
-      #   between actual import and closing bracket.
-      #
-      # Default: true
-      align: false
-
-      # stylish-haskell can detect redundancy of some language pragmas. If this
-      # is set to true, it will remove those redundant pragmas. Default: true.
-      remove_redundant: true
-
-      # Language prefix to be used for pragma declaration, this allows you to
-      # use other options non case-sensitive like "language" or "Language".
-      # If a non correct String is provided, it will default to: LANGUAGE.
-      language_prefix: LANGUAGE
-
-  # Replace tabs by spaces. This is disabled by default.
-  # - tabs:
-  #     # Number of spaces to use for each tab. Default: 8, as specified by the
-  #     # Haskell report.
-  #     spaces: 8
-
-  # Remove trailing whitespace
-  - trailing_whitespace: {}
-
-  # Squash multiple spaces between the left and right hand sides of some
-  # elements into single spaces. Basically, this undoes the effect of
-  # simple_align but is a bit less conservative.
-  # - squash: {}
-
-# A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account.
-#
-# Set this to null to disable all line wrapping.
-#
-# Default: 80.
-columns: 100
-
-# By default, line endings are converted according to the OS. You can override
-# preferred format here.
-#
-# - native: Native newline format. CRLF on Windows, LF on other OSes.
-#
-# - lf: Convert to LF ("\n").
-#
-# - crlf: Convert to CRLF ("\r\n").
-#
-# Default: native.
-newline: native
-
-# Sometimes, language extensions are specified in a cabal file or from the
-# command line instead of using language pragmas in the file. stylish-haskell
-# needs to be aware of these, so it can parse the file correctly.
-#
-# No language extensions are enabled by default.
-# language_extensions:
-  # - TemplateHaskell
-  # - QuasiQuotes
-
-# Attempt to find the cabal file in ancestors of the current directory, and
-# parse options (currently only language extensions) from that.
-#
-# Default: true
-cabal: true

README.md

@@ -7,3 +7,9 @@
     - So we're gonna do the PDFs after all
     - Let's hope we can deduce the PDF path from the link
     - And also that the PDFs aren't generated on demand as well.
+
+## TODO
+
+- CI
+- Docker container (in flake)
+- try fourmolu

app/Main.hs

@@ -13,17 +13,17 @@ import Data.Time (Day, toGregorian)
 import Network.HTTP.Media ((//), (/:))
 import Network.HTTP.Types (status200)
 import Servant
-    ( Accept (..)
-    , Capture
-    , Get
-    , MimeRender (..)
-    , Raw
-    , Server
-    , Tagged (..)
-    , serve
-    , (:<|>) (..)
-    , (:>)
-    )
+  ( Accept (..)
+  , Capture
+  , Get
+  , MimeRender (..)
+  , Raw
+  , Server
+  , Tagged (..)
+  , serve
+  , (:<|>) (..)
+  , (:>)
+  )
 import System.FilePath ((</>))
 import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
 import Text.Blaze.Html5 ((!))
@@ -48,20 +48,21 @@ main :: IO ()
 main = do
   capabilities <- getNumCapabilities
   let maxResources = capabilities
-  connPool <- newPool $ defaultPoolConfig
-    (unsafeConnect "host=localhost port=5433 user=yore-test dbname=yore-test")
-    Opium.close
-    10
-    maxResources
+  connPool <-
+    newPool $
+      defaultPoolConfig
+        (unsafeConnect "host=localhost port=5433 user=yore-test dbname=yore-test")
+        Opium.close
+        10
+        maxResources
   Warp.run 3000 $ serve (Proxy :: Proxy API) $ server connPool
-
   where
     unsafeConnect s = either throwIO pure =<< Opium.connect s
 
-type API
-  = Get '[HTML] RootModel
-  :<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel
-  :<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> Raw
+type API =
+  Get '[HTML] RootModel
+    :<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel
+    :<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> Raw
 
 server :: Pool Opium.Connection -> Server API
 server connPool = rootR :<|> todayR :<|> apiTodayR
@@ -82,13 +83,14 @@ server connPool = rootR :<|> todayR :<|> apiTodayR
         let fullPath = "download" </> dayFile.relative_path
         secondsUntilMidnight <- getSecondsUntilMidnight
 
-        respond $ responseFile
-          status200
-          [ ("content-type", "application/pdf")
-          , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
-          ]
-          fullPath
-          Nothing
+        respond $
+          responseFile
+            status200
+            [ ("content-type", "application/pdf")
+            , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
+            ]
+            fullPath
+            Nothing
 
 data RootModel = RootModel Day DB.DayFile Int Int
 
@@ -96,7 +98,8 @@ instance MimeRender HTML RootModel where
   mimeRender _ (RootModel dateThen dayFile issue count) = renderHtml $ do
     H.docTypeHtml $ do
       H.head $ do
-        H.style "body { margin: 0; font-family: Helvetica, sans-serif; } .layout { display: flex; flex-direction: column; width: 100vw; height: 100vh; } .topbar { user-select: none; text-align: center; padding: .5em; } .content { flex: 1; } iframe { border: 0; }"
+        H.style
+          "body { margin: 0; font-family: Helvetica, sans-serif; } .layout { display: flex; flex-direction: column; width: 100vw; height: 100vh; } .topbar { user-select: none; text-align: center; padding: .5em; } .content { flex: 1; } iframe { border: 0; }"
       H.body $ do
         H.div ! A.class_ "layout" $ do
           H.div ! A.class_ "topbar" $ do
@@ -113,11 +116,11 @@ instance MimeRender HTML RootModel where
 
       buildLink label issue'
         | issue' == 0 =
-          H.a ! A.href "/" $ label
+            H.a ! A.href "/" $ label
         | issue' > 0 && issue' < count =
-          H.a ! A.href (H.toValue (printf "/today/issue/%d" issue' :: String)) $ label
+            H.a ! A.href (H.toValue (printf "/today/issue/%d" issue' :: String)) $ label
         | otherwise =
-          H.span ! A.style "color: grey;" $ label
+            H.span ! A.style "color: grey;" $ label
 
 -- Utils
 

flake.nix

@@ -74,7 +74,7 @@
                   pkgs.cabal-install
                   pkgs.haskellPackages.implicit-hie
                   pkgs.haskell-language-server
-                  pkgs.stylish-haskell
+                  pkgs.fourmolu
                   pkgs.postgresql
                   pkgs.dbmate
                 ];

fourmolu.yaml

@@ -0,0 +1,22 @@
+indentation: 2
+column-limit: 120
+function-arrows: leading
+comma-style: leading
+import-export-style: leading
+import-grouping: by-scope-then-qualified
+indent-wheres: true
+record-brace-space: true
+newlines-between-decls: 1
+haddock-style: single-line
+haddock-style-module: single-line
+haddock-location-signature: auto
+let-style: auto
+in-style: left-align
+single-constraint-parens: always
+single-deriving-parens: always
+sort-constraints: false
+sort-derived-classes: false
+sort-deriving-clauses: false
+trailing-section-operators: true
+unicode: never
+respectful: true

src/Yore/DB.hs

@@ -14,7 +14,7 @@ module Yore.DB
   , getNumberOfIssues
   , Table (..)
   , getTables
-) where
+  ) where
 
 import Data.Functor.Identity (Identity (..))
 import Data.Text (Text)
@@ -25,38 +25,44 @@ import qualified Database.PostgreSQL.Opium as Opium
 
 data Table = Table
   { schema :: String
-  , name   :: String
-  } deriving (Show, Generic, Opium.FromRow)
+  , name :: String
+  }
+  deriving (Show, Generic, Opium.FromRow)
 
 getTables :: Opium.Connection -> IO (Either Opium.Error [Table])
 getTables = Opium.fetch_ "SELECT table_schema AS schema, table_name AS name FROM information_schema.tables"
 
 data DayIndex = DayIndex
   { day_index_id :: Int
-  , day          :: Day
-  } deriving (Show, Generic, Opium.FromRow)
+  , day :: Day
+  }
+  deriving (Show, Generic, Opium.FromRow)
 
 data DayFile = DayFile
-  { day_file_id   :: Int
-  , day_index_id  :: Int
-  , label         :: Text
+  { day_file_id :: Int
+  , day_index_id :: Int
+  , label :: Text
   , relative_path :: FilePath
-  } deriving (Show, Generic, Opium.FromRow)
+  }
+  deriving (Show, Generic, Opium.FromRow)
 
 newtype CountResult = CountResult
   { count :: Int
-  } deriving (Show, Generic, Opium.FromRow)
+  }
+  deriving (Show, Generic, Opium.FromRow)
 
 createDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error DayIndex)
-createDayIndex date = ex runIdentity .
-  Opium.fetch
-    "INSERT INTO yore.day_index (day) VALUES ($1) RETURNING *"
-    (Identity date)
+createDayIndex date =
+  ex runIdentity
+    . Opium.fetch
+      "INSERT INTO yore.day_index (day) VALUES ($1) RETURNING *"
+      (Identity date)
 
 createDayFile :: Int -> Text -> FilePath -> Opium.Connection -> IO (Either Opium.Error ())
 createDayFile dayId label path =
   Opium.execute
-    "INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)" (dayId, label, path)
+    "INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)"
+    (dayId, label, path)
 
 readDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error (Maybe DayIndex))
 readDayIndex date =
@@ -71,16 +77,18 @@ readDayPaths date =
     (Identity date)
 
 getDayFileByIssue :: Day -> Int -> Opium.Connection -> IO (Either Opium.Error DayFile)
-getDayFileByIssue date issue = ex runIdentity .
-  Opium.fetch
-    "SELECT yore.day_file.* FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1 ORDER BY day_file_id LIMIT 1 OFFSET $2"
-    (date, issue)
+getDayFileByIssue date issue =
+  ex runIdentity
+    . Opium.fetch
+      "SELECT yore.day_file.* FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1 ORDER BY day_file_id LIMIT 1 OFFSET $2"
+      (date, issue)
 
 getNumberOfIssues :: Day -> Opium.Connection -> IO (Either Opium.Error Int)
-getNumberOfIssues date = ex (count . runIdentity) .
-  Opium.fetch
-    "SELECT count(*) FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
-    (Identity date)
+getNumberOfIssues date =
+  ex (count . runIdentity)
+    . Opium.fetch
+      "SELECT count(*) FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
+      (Identity date)
 
 ex :: (a -> b) -> IO (Either e a) -> IO (Either e b)
 ex = fmap . fmap

src/Yore/Download.hs

@@ -17,8 +17,10 @@ import qualified Text.URI as URI
 -- | Download a URL and save it to a directory.
 -- Returns the path of the downloaded file relative to the directory.
 downloadInto
-  :: FilePath -- ^ Directory where to store the file.
-  -> Text -- ^ The URL to download.
+  :: FilePath
+  -- ^ Directory where to store the file.
+  -> Text
+  -- ^ The URL to download.
   -> IO FilePath
 downloadInto downloadDir textUrl = download >>= save
   where

src/Yore/Index.hs

@@ -20,5 +20,5 @@ createEntries date urls conn = do
     confidently $ DB.createDayFile dayIndex.day_index_id text url conn
   confidently $ Opium.execute_ "COMMIT" conn
 
-confidently :: Exception e => IO (Either e a) -> IO a
+confidently :: (Exception e) => IO (Either e a) -> IO a
 confidently action = action >>= either throwIO pure

src/Yore/Scrape.hs

@@ -15,20 +15,20 @@ import Data.Maybe (listToMaybe, mapMaybe)
 import Data.Text (Text)
 import Data.Time (Day, MonthOfYear, Year, fromGregorian, toGregorian)
 import Network.HTTP.Req
-    ( BsResponse
-    , GET (..)
-    , NoReqBody (..)
-    , Req
-    , bsResponse
-    , defaultHttpConfig
-    , formToQuery
-    , https
-    , req
-    , responseBody
-    , responseStatusCode
-    , runReq
-    , (/:)
-    )
+  ( BsResponse
+  , GET (..)
+  , NoReqBody (..)
+  , Req
+  , bsResponse
+  , defaultHttpConfig
+  , formToQuery
+  , https
+  , req
+  , responseBody
+  , responseStatusCode
+  , runReq
+  , (/:)
+  )
 import Text.HTML.Parser (Attr (..), Token (..), parseTokens)
 import Text.Printf (printf)
 import Text.URI (URI)
@@ -41,18 +41,20 @@ import qualified Text.URI as URI
 
 -- | A single issue of a newspaper. There may be multiple isses per day.
 data Issue = Issue
-  { day   :: Day
+  { day :: Day
   , label :: Text
   -- ^ A human-readable label for the issue, e.g. @1. Blatt@, @Sportblatt@ or @Handelsblatt@.
-  , url   :: Text
+  , url :: Text
   -- ^ Where to fetch the PDF file for this issue.
-  } deriving (Eq, Show)
+  }
+  deriving (Eq, Show)
 
 data Target = Target
-  { day    :: Day
-  , label  :: Text
+  { day :: Day
+  , label :: Text
   , params :: Params
-  } deriving (Eq, Show)
+  }
+  deriving (Eq, Show)
 
 type Params = (Text, Text, Text)
 
@@ -80,37 +82,42 @@ getIssueByTarget target = do
   let mbRefreshTarget = listToMaybe $ mapMaybe getRefreshTarget htmlTokens
   refreshTarget <-
     maybe (error "couldnt find refresh target") pure mbRefreshTarget
-  pure $ Issue
-    { day = target.day
-    , label = target.label
-    , url = refreshTarget
-    }
+  pure $
+    Issue
+      { day = target.day
+      , label = target.label
+      , url = refreshTarget
+      }
 
 showmonthRequest :: Year -> MonthOfYear -> Req BsResponse
-showmonthRequest year month = req
-  GET
-  (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
-  NoReqBody
-  bsResponse
-  (formToQuery
-    [ ("cmd", "showmonth") :: (String, String)
-    , ("year", printf "%04d" year)
-    , ("month", printf "%02d" month)
-    , ("project", "3")
-    ])
+showmonthRequest year month =
+  req
+    GET
+    (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
+    NoReqBody
+    bsResponse
+    ( formToQuery
+        [ ("cmd", "showmonth") :: (String, String)
+        , ("year", printf "%04d" year)
+        , ("month", printf "%02d" month)
+        , ("project", "3")
+        ]
+    )
 
 showpdfRequest :: Params -> Req BsResponse
-showpdfRequest (y, m, d) = req
-  GET
-  (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
-  NoReqBody
-  bsResponse
-  (formToQuery
-    [ ("cmd" :: Text, "showpdf")
-    , ("year", y)
-    , ("month", m)
-    , ("day", d)
-    ])
+showpdfRequest (y, m, d) =
+  req
+    GET
+    (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
+    NoReqBody
+    bsResponse
+    ( formToQuery
+        [ ("cmd" :: Text, "showpdf")
+        , ("year", y)
+        , ("month", m)
+        , ("day", d)
+        ]
+    )
 
 parseTargets :: [Token] -> [Target]
 parseTargets = q0 []
@@ -147,7 +154,7 @@ getShowday t = do
 
 getAHref :: Token -> Maybe Text
 getAHref (TagOpen "a" attrs) = getAttr "href" attrs
-getAHref _                   = Nothing
+getAHref _ = Nothing
 
 getRefreshTarget :: Token -> Maybe Text
 getRefreshTarget (TagOpen "meta" attrs) = do
@@ -180,9 +187,9 @@ getParam param uri =
 decodeDecimalEntities :: Text -> Text
 decodeDecimalEntities = Text.pack . q0 . Text.unpack
   where
-    q0 ""              = ""
+    q0 "" = ""
     q0 ('&' : '#' : r) = q1 0 r
-    q0 (c : r)         = c : q0 r
+    q0 (c : r) = c : q0 r
 
     -- Silently swallows broken entities at the end of the string...
     q1 _ "" = ""

src/Yore/Time.hs

@@ -1,24 +1,23 @@
 module Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight) where
 
 import Data.Time
-    ( Day
-    , addGregorianYearsClip
-    , getZonedTime
-    , isLeapYear
-    , localDay
-    , localTimeOfDay
-    , sinceMidnight
-    , toGregorian
-    , zonedTimeToLocalTime
-    )
+  ( Day
+  , addGregorianYearsClip
+  , getZonedTime
+  , isLeapYear
+  , localDay
+  , localTimeOfDay
+  , sinceMidnight
+  , toGregorian
+  , zonedTimeToLocalTime
+  )
 
 addYears :: Integer -> Day -> Maybe Day
 addYears yearOffset date
   | isFebruary29th && not (isLeapYear year') =
-    Nothing
+      Nothing
   | otherwise =
-    Just $ addGregorianYearsClip yearOffset date
-
+      Just $ addGregorianYearsClip yearOffset date
   where
     (year, month, day) = toGregorian date
     year' = year + yearOffset

yore.cabal

@@ -27,6 +27,8 @@ common shared-options
     -Wpartial-fields
     -Wredundant-constraints
   default-language: GHC2021
+  default-extensions:
+    NoImportQualifiedPost
 
 library
   import: shared-options