Use fourmolu instead of stylish-haskell
This commit is contained in:
parent
1cb8c26dfc
commit
e8b083a260
@ -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
|
|
||||||
@ -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
|
||||||
|
|||||||
15
app/Main.hs
15
app/Main.hs
@ -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
|
||||||
|
|||||||
@ -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
22
fourmolu.yaml
Normal 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
|
||||||
@ -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)
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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 []
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user