Use fourmolu instead of stylish-haskell

This commit is contained in:
Paul Brinkmeier 2025-08-07 18:34:01 +02:00
parent 1cb8c26dfc
commit e8b083a260
11 changed files with 171 additions and 603 deletions

View File

@ -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

View File

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

View File

@ -48,18 +48,19 @@ main :: IO ()
main = do main = do
capabilities <- getNumCapabilities capabilities <- getNumCapabilities
let maxResources = capabilities let maxResources = capabilities
connPool <- newPool $ defaultPoolConfig connPool <-
newPool $
defaultPoolConfig
(unsafeConnect "host=localhost port=5433 user=yore-test dbname=yore-test") (unsafeConnect "host=localhost port=5433 user=yore-test dbname=yore-test")
Opium.close Opium.close
10 10
maxResources maxResources
Warp.run 3000 $ serve (Proxy :: Proxy API) $ server connPool Warp.run 3000 $ serve (Proxy :: Proxy API) $ server connPool
where where
unsafeConnect s = either throwIO pure =<< Opium.connect s unsafeConnect s = either throwIO pure =<< Opium.connect s
type API type API =
= Get '[HTML] RootModel Get '[HTML] RootModel
:<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel :<|> "today" :> "issue" :> Capture "issue" Int :> Get '[HTML] RootModel
:<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> Raw :<|> "api" :> "today" :> "issue" :> Capture "issue" Int :> "fz.pdf" :> Raw
@ -82,7 +83,8 @@ server connPool = rootR :<|> todayR :<|> apiTodayR
let fullPath = "download" </> dayFile.relative_path let fullPath = "download" </> dayFile.relative_path
secondsUntilMidnight <- getSecondsUntilMidnight secondsUntilMidnight <- getSecondsUntilMidnight
respond $ responseFile respond $
responseFile
status200 status200
[ ("content-type", "application/pdf") [ ("content-type", "application/pdf")
, ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight) , ("cache-control", BS8.pack $ printf "public, max-age=%d" secondsUntilMidnight)
@ -96,7 +98,8 @@ instance MimeRender HTML RootModel where
mimeRender _ (RootModel dateThen dayFile issue count) = renderHtml $ do mimeRender _ (RootModel dateThen dayFile issue count) = renderHtml $ do
H.docTypeHtml $ do H.docTypeHtml $ do
H.head $ 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.body $ do
H.div ! A.class_ "layout" $ do H.div ! A.class_ "layout" $ do
H.div ! A.class_ "topbar" $ do H.div ! A.class_ "topbar" $ do

View File

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

22
fourmolu.yaml Normal file
View File

@ -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

View File

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

View File

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

View File

@ -20,5 +20,5 @@ createEntries date urls conn = do
confidently $ DB.createDayFile dayIndex.day_index_id text url conn confidently $ DB.createDayFile dayIndex.day_index_id text url conn
confidently $ Opium.execute_ "COMMIT" 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 confidently action = action >>= either throwIO pure

View File

@ -46,13 +46,15 @@ data Issue = Issue
-- ^ A human-readable label for the issue, e.g. @1. Blatt@, @Sportblatt@ or @Handelsblatt@. -- ^ 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. -- ^ Where to fetch the PDF file for this issue.
} deriving (Eq, Show) }
deriving (Eq, Show)
data Target = Target data Target = Target
{ day :: Day { day :: Day
, label :: Text , label :: Text
, params :: Params , params :: Params
} deriving (Eq, Show) }
deriving (Eq, Show)
type Params = (Text, Text, Text) type Params = (Text, Text, Text)
@ -80,37 +82,42 @@ getIssueByTarget target = do
let mbRefreshTarget = listToMaybe $ mapMaybe getRefreshTarget htmlTokens let mbRefreshTarget = listToMaybe $ mapMaybe getRefreshTarget htmlTokens
refreshTarget <- refreshTarget <-
maybe (error "couldnt find refresh target") pure mbRefreshTarget maybe (error "couldnt find refresh target") pure mbRefreshTarget
pure $ Issue pure $
Issue
{ day = target.day { day = target.day
, label = target.label , label = target.label
, url = refreshTarget , url = refreshTarget
} }
showmonthRequest :: Year -> MonthOfYear -> Req BsResponse showmonthRequest :: Year -> MonthOfYear -> Req BsResponse
showmonthRequest year month = req showmonthRequest year month =
req
GET GET
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi") (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
NoReqBody NoReqBody
bsResponse bsResponse
(formToQuery ( formToQuery
[ ("cmd", "showmonth") :: (String, String) [ ("cmd", "showmonth") :: (String, String)
, ("year", printf "%04d" year) , ("year", printf "%04d" year)
, ("month", printf "%02d" month) , ("month", printf "%02d" month)
, ("project", "3") , ("project", "3")
]) ]
)
showpdfRequest :: Params -> Req BsResponse showpdfRequest :: Params -> Req BsResponse
showpdfRequest (y, m, d) = req showpdfRequest (y, m, d) =
req
GET GET
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi") (https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
NoReqBody NoReqBody
bsResponse bsResponse
(formToQuery ( formToQuery
[ ("cmd" :: Text, "showpdf") [ ("cmd" :: Text, "showpdf")
, ("year", y) , ("year", y)
, ("month", m) , ("month", m)
, ("day", d) , ("day", d)
]) ]
)
parseTargets :: [Token] -> [Target] parseTargets :: [Token] -> [Target]
parseTargets = q0 [] parseTargets = q0 []

View File

@ -18,7 +18,6 @@ addYears yearOffset date
Nothing Nothing
| otherwise = | otherwise =
Just $ addGregorianYearsClip yearOffset date Just $ addGregorianYearsClip yearOffset date
where where
(year, month, day) = toGregorian date (year, month, day) = toGregorian date
year' = year + yearOffset year' = year + yearOffset

View File

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