From b49e77de8a69e3f71aed84832fbc47a1a770d2d8 Mon Sep 17 00:00:00 2001 From: Saku Laesvuori Date: Wed, 5 Aug 2026 12:22:06 +0300 Subject: [PATCH] =?UTF-8?q?Korjaa=20k=C3=A4=C3=A4nt=C3=A4minen=20uudella?= =?UTF-8?q?=20Guix=20versiolla?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .guix/modules/tiedote-md-package.scm | 887 ++++++++---------- .../ghc-doclayout-add-lift-instance.patch | 149 +++ channels.scm | 2 +- src/Main.hs | 6 +- src/TiedoteMD/Read.hs | 3 +- src/TiedoteMD/Templates/TH.hs | 2 - tiedote-md.cabal | 4 +- 7 files changed, 571 insertions(+), 482 deletions(-) create mode 100644 .guix/patches/ghc-doclayout-add-lift-instance.patch diff --git a/.guix/modules/tiedote-md-package.scm b/.guix/modules/tiedote-md-package.scm index 38c15ed..a87bf7e 100644 --- a/.guix/modules/tiedote-md-package.scm +++ b/.guix/modules/tiedote-md-package.scm @@ -15,10 +15,12 @@ #:use-module (gnu packages version-control)) (define vcs-file? - (or (git-predicate (string-append (current-source-directory) "/../..")) + (or (and=> (current-source-directory) + (lambda (dir) + (git-predicate (string-append dir "/../..")))) (const #t))) -(define-public tiedote-md +(define tiedote-md* (package (name "tiedote-md") (version "0.0.1-git") @@ -29,7 +31,7 @@ (inputs (list ghc-acid-state ghc-attoparsec ghc-base64 - ghc-cryptonite + ghc-crypton ghc-case-insensitive ghc-glob ghc-purebred-email @@ -65,461 +67,338 @@ sähköpostipohjaista käyttöliittymää. Toistaiseksi tiedote.md on kovakoodat käyttämään OMS:n tiedotepohjia.") (license license:agpl3+))) -(define ghc-scotty +(define ghc-template-haskell-lift (package - (name "ghc-scotty") - (version "0.12") - (source (origin - (method url-fetch) - (uri (hackage-uri "scotty" version)) - (sha256 - (base32 - "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1")))) + (name "ghc-template-haskell-lift") + (version "0.1.0.0") + (source + (origin + (method url-fetch) + (uri (hackage-uri "template-haskell-lift" version)) + (sha256 + (base32 "09zilw0nbjmn1k688l058183rwa3br0fvh3x8jxqygjh3011w8ps")))) (build-system haskell-build-system) - (inputs (list ghc-aeson - ghc-base-compat-batteries - ghc-blaze-builder - ghc-case-insensitive - ghc-data-default-class - ghc-fail - ghc-http-types - ghc-monad-control - ghc-nats - ghc-network - ghc-regex-compat - ghc-transformers-base - ghc-transformers-compat - ghc-wai - ghc-wai-extra - ghc-warp)) - (native-inputs (list ghc-async ghc-hspec ghc-hspec-wai ghc-lifted-base hspec-discover)) + (properties '((upstream-name . "template-haskell-lift"))) (arguments - `(#:cabal-revision ("7" - "1i8icc612w4dbmqmnf99drqpmjvhjnkmqgk9xr63amj8jkz5lp4m"))) - (home-page "https://github.com/scotty-web/scotty") - (synopsis - "Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp") + `(#:cabal-revision ("1" + "072g7a9b2sp0vc3g48xqbrxfis1rizqakz0b8064hs0cbgj3xkgn"))) + (home-page "http://hackage.haskell.org/package/template-haskell-lift") + (synopsis "The 'Lift' typeclass.") (description - "This package provides a Haskell web framework inspired by Ruby's Sinatra, using -WAI and Warp. . @ {-# LANGUAGE OverloadedStrings #-} . import -Web.Scotty . import Data.Monoid (mconcat) . main = scotty 3000 $ get -"/:word" $ do beam <- param "word" - html $ mconcat ["<h1>Scotty, ", beam, " -me up!</h1>"] @ . . Scotty is the cheap and cheerful way to write -RESTful, declarative web applications. . * A page is as simple as defining the -verb, url pattern, and Text content. . * It is template-language agnostic. -Anything that returns a Text value will do. . * Conforms to WAI Application -interface. . * Uses very fast Warp webserver by default. . As for the name: -Sinatra + Warp = Scotty. . [WAI] . -[Warp] ") - (license license:bsd-3))) + "The stable home of @code{TemplateHaskell's} Lift typeclass, which implements +cross-stage persistence for Template Haskell.") + (license license:bsd-2))) -(define ghc-hspec-wai +(define ghc-doclayout* (package - (name "ghc-hspec-wai") - (version "0.11.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "hspec-wai" version)) - (sha256 - (base32 - "03wiksic5y9a2g6a86nsxrnajdgdvpv17w02h5qla0zp9zs6pa1j")))) - (build-system haskell-build-system) - (inputs (list ghc-quickcheck - ghc-base-compat - ghc-case-insensitive - ghc-hspec-core - ghc-hspec-expectations - ghc-http-types - ghc-wai - ghc-wai-extra)) - (native-inputs (list ghc-hspec hspec-discover)) - (home-page "https://github.com/hspec/hspec-wai#readme") - (synopsis "Experimental Hspec support for testing WAI applications") - (description "Experimental Hspec support for testing WAI applications") - (license license:expat))) + (inherit ghc-doclayout) + (source + (origin + (inherit (package-source ghc-doclayout)) + (patches + (list (local-file "../patches/ghc-doclayout-add-lift-instance.patch"))))) + (inputs (modify-inputs (package-inputs ghc-doclayout) + (append ghc-template-haskell-lift))))) + +(define-public tiedote-md + ((package-input-rewriting `((,ghc-doclayout . ,ghc-doclayout*))) + tiedote-md*)) (define ghc-acid-state (package - (name "ghc-acid-state") - (version "0.16.1.2") - (source (origin - (method url-fetch) - (uri (hackage-uri "acid-state" version)) - (sha256 - (base32 - "1ixg62liif1g18ggxap8zdhzy261fj5d24pmb0n36gfhz18b38bx")))) - (build-system haskell-build-system) - (properties '((upstream-name . "acid-state"))) - (inputs (list ghc-cereal - ghc-safecopy - ghc-filelock - ghc-network - ghc-network-bsd - ghc-th-expand-syns)) - (native-inputs (list ghc-hspec ghc-hspec-discover ghc-hedgehog)) - (home-page "https://github.com/acid-state/acid-state") - (synopsis "Add ACID guarantees to any serializable Haskell data structure.") - (description - "Use regular Haskell data structures as your database and get stronger ACID -guarantees than most RDBMS offer.") - (license license:public-domain))) - -(define ghc-safecopy - (package - (name "ghc-safecopy") - (version "0.10.4.2") - (source (origin - (method url-fetch) - (uri (hackage-uri "safecopy" version)) - (sha256 - (base32 - "0r2mf0p82gf8vnldx477b5ykrj1x7hyg13nqfn6gzb50japs6h3i")))) - (build-system haskell-build-system) - (properties '((upstream-name . "safecopy"))) - (inputs (list ghc-cereal - ghc-generic-data - ghc-old-time - ghc-vector)) - (native-inputs (list ghc-lens - ghc-lens-action - ghc-tasty - ghc-tasty-quickcheck - ghc-quickcheck-instances - ghc-quickcheck - ghc-hunit)) - (arguments - `(#:cabal-revision ("6" - "0ii5cdg4l4ww81p7gd5m3z2jdqrs2hvqhwzrlz267nzxbws00x0b"))) - (home-page "https://github.com/acid-state/safecopy") - (synopsis "Binary serialization with version control.") - (description "An extension to Data.Serialize with built-in version control.") - (license license:public-domain))) - -(define ghc-generic-data - (package - (name "ghc-generic-data") - (version "1.0.0.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "generic-data" version)) - (sha256 - (base32 - "0fz65k4sxn9c23rg5iv0vij2mksl5rkn6dl2f3i9d9d60b5wca9y")))) - (build-system haskell-build-system) - (properties '((upstream-name . "generic-data"))) - (inputs (list ghc-ap-normalize - ghc-contravariant - ghc-show-combinators)) - (native-inputs (list ghc-tasty - ghc-tasty-hunit - ghc-tasty - ghc-tasty-hunit - ghc-tasty - ghc-tasty-hunit - ghc-generic-lens - ghc-tasty - ghc-tasty-hunit - ghc-generic-lens - ghc-one-liner)) - (home-page "https://github.com/Lysxia/generic-data#readme") - (synopsis "Deriving instances with GHC.Generics and related utilities") - (description - "Generic implementations of standard type classes. Operations on generic -representations to help using \"GHC.Generics\". See README.") - (license license:expat))) - -(define ghc-lens-action - (package - (name "ghc-lens-action") - (version "0.2.6") - (source (origin - (method url-fetch) - (uri (hackage-uri "lens-action" version)) - (sha256 - (base32 - "0cdprc5j6r976dmrga2zwvcr7qsv7nqy3nvncp66yyy0dk2qlwm3")))) - (build-system haskell-build-system) - (properties '((upstream-name . "lens-action"))) - (inputs (list ghc-lens ghc-comonad ghc-contravariant ghc-profunctors - ghc-semigroupoids)) - (arguments - `(#:cabal-revision ("2" - "0rrrv7k0fz98j99a6gzw858v5w3i378g0b7ijj30dz2am6p6rfnm"))) - (home-page "http://github.com/ekmett/lens-action/") - (synopsis "Monadic Getters and Folds") - (description - "This package contains combinators and types for working with monadic getters and -folds as split off from the original lens package.") - (license license:bsd-3))) + (name "ghc-acid-state") + (version "0.16.1.4") + (source + (origin + (method url-fetch) + (uri (hackage-uri "acid-state" version)) + (sha256 + (base32 "1z3q0d83dmdhr2s0bh4vhlyz82wik3w8gdmqs5mxk6kw6g7f0xzl")))) + (build-system haskell-build-system) + (properties '((upstream-name . "acid-state"))) + (inputs (list ghc-cereal + ghc-safecopy + ghc-filelock + ghc-network + ghc-network-bsd + ghc-th-expand-syns)) + (native-inputs (list hspec-discover ghc-hspec ghc-hedgehog)) + (home-page "https://github.com/acid-state/acid-state") + (synopsis + "Add ACID guarantees to any serializable Haskell data structure.") + (description + "Use regular Haskell data structures as your database and get stronger ACID + guarantees than most RDBMS offer.") + (license license:public-domain))) (define ghc-ap-normalize (package - (name "ghc-ap-normalize") - (version "0.1.0.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "ap-normalize" version)) - (sha256 - (base32 - "1212zxc4qn6msk0w13yhrza2qjs79h78misllb4chng75jqi61l2")))) - (build-system haskell-build-system) - (properties '((upstream-name . "ap-normalize"))) - (native-inputs (list ghc-inspection-testing ghc-inspection-testing)) - (home-page "http://hackage.haskell.org/package/ap-normalize") - (synopsis "Self-normalizing applicative expressions") - (description - "An applicative functor transformer to normalize expressions using @@(\\<$>)@@, -@@(\\<*>)@@, and @@pure@@ into a linear list of actions. See \"ApNormalize\" to -get started.") - (license license:expat))) + (name "ghc-ap-normalize") + (version "0.1.0.1") + (source + (origin + (method url-fetch) + (uri (hackage-uri "ap-normalize" version)) + (sha256 + (base32 "1212zxc4qn6msk0w13yhrza2qjs79h78misllb4chng75jqi61l2")))) + (build-system haskell-build-system) + (properties '((upstream-name . "ap-normalize"))) + (arguments (list #:tests? #f)) + (home-page "http://hackage.haskell.org/package/ap-normalize") + (synopsis "Self-normalizing applicative expressions") + (description + "An applicative functor transformer to normalize expressions using @@(\\<$>)@@, +@@(\\<*>)@@, and @@pure@@ into a linear list of actions. See +\"@code{ApNormalize}\" to get started.") + (license license:expat))) -(define ghc-show-combinators +(define ghc-concise (package - (name "ghc-show-combinators") - (version "0.2.0.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "show-combinators" version)) - (sha256 - (base32 - "07ds87ldl9165hj3k5h84iawc6vqlbggni3dg1nhbxww1spxn0n9")))) - (build-system haskell-build-system) - (properties '((upstream-name . "show-combinators"))) - (arguments - `(#:cabal-revision ("2" - "0n3xlpm41wpw1ybmacg9s7150nx00qrdlw2rq4fzz7iw7333cyjx"))) - (home-page "https://github.com/Lysxia/show-combinators#readme") - (synopsis "Combinators to write Show instances") - (description - "This package provides a minimal pretty-printing library for Show instances in -Haskell.") - (license license:expat))) + (name "ghc-concise") + (version "0.1.0.1") + (source + (origin + (method url-fetch) + (uri (hackage-uri "concise" version)) + (sha256 + (base32 "09crgc6gjfidlad6263253xx1di6wfhc9awhira21s0z7rddy9sw")))) + (build-system haskell-build-system) + (properties '((upstream-name . "concise"))) + (inputs (list ghc-lens)) + (native-inputs (list ghc-tasty ghc-tasty-quickcheck ghc-quickcheck + ghc-quickcheck-instances)) + (home-page "https://github.com/frasertweedale/hs-concise") + (synopsis "Utilities for Control.Lens.Cons") + (description + "concise provides a handful of functions to extend what you can do with +Control.Lens.Cons.") + (license license:bsd-3))) -(define ghc-generic-lens +(define ghc-exit-codes (package - (name "ghc-generic-lens") - (version "2.2.2.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "generic-lens" version)) - (sha256 - (base32 - "0s4b51s11ssmndmx9m9zbwgv9rb27ajwihsrk10hn582rp4ck3c6")))) - (build-system haskell-build-system) - (properties '((upstream-name . "generic-lens"))) - (inputs (list ghc-generic-lens-core ghc-profunctors)) - (native-inputs (list ghc-lens - ghc-inspection-testing - ghc-hunit - ghc-lens - ghc-hunit - ghc-lens - ghc-hunit - ghc-doctest - ghc-lens)) - (home-page "https://github.com/kcsongor/generic-lens") - (synopsis "Generically derive traversals, lenses and prisms.") - (description - "This library uses GHC.Generics to derive efficient optics (traversals, lenses -and prisms) for algebraic data types in a type-directed way, with a focus on -good type inference and error messages when possible. The library exposes a -van Laarhoven interface. For an alternative interface, supporting an opaque -optic type, see @@@@.") - (license license:bsd-3))) - -(define ghc-one-liner - (package - (name "ghc-one-liner") - (version "2.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "one-liner" version)) - (sha256 - (base32 - "09gdivd38disddxs42179vmgca0yzk5dfm6ygicgl5l25qbizrfh")))) - (build-system haskell-build-system) - (properties '((upstream-name . "one-liner"))) - (inputs (list ghc-contravariant ghc-bifunctors ghc-profunctors ghc-tagged - ghc-linear-base)) - (native-inputs (list ghc-hunit)) - (arguments - `(#:cabal-revision ("1" - "1n6d74s0x91qi4fi6wv5yggjb1nvwk0ir580mkf67bca2x6f1cqn"))) - (home-page "https://github.com/sjoerdvisscher/one-liner") - (synopsis "Constraint-based generics") - (description - "Write short and concise generic instances of type classes. one-liner is -particularly useful for writing default implementations of type class methods.") - (license license:bsd-3))) - -(define ghc-generic-lens-core - (package - (name "ghc-generic-lens-core") - (version "2.2.1.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "generic-lens-core" version)) - (sha256 - (base32 - "08i4c9yb6z84iknrnl9f3f343121j7ilp0a679v81nsjm9xz3rlf")))) - (build-system haskell-build-system) - (properties '((upstream-name . "generic-lens-core"))) - (inputs (list ghc-indexed-profunctors)) - (arguments - `(#:cabal-revision ("1" - "1dbjhd6k7ypqa9f4h9v2xndgb4mjhfli3n1vjm8r8ga0kfndbqfn"))) - (home-page "https://github.com/kcsongor/generic-lens") - (synopsis "Generically derive traversals, lenses and prisms.") - (description - "This library uses GHC.Generics to derive efficient optics (traversals, lenses -and prisms) for algebraic data types in a type-directed way, with a focus on -good type inference and error messages when possible. This package is the -shared internal logic of the @@@@ and @@@@ libraries.") - (license license:bsd-3))) - -(define ghc-indexed-profunctors - (package - (name "ghc-indexed-profunctors") - (version "0.1.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "indexed-profunctors" version)) - (sha256 - (base32 - "1cbccbvrx73drr1jf3yyw0rp1mcfv3jc1rvdcby5xxx4ja543fjs")))) - (build-system haskell-build-system) - (properties '((upstream-name . "indexed-profunctors"))) - (home-page "http://hackage.haskell.org/package/indexed-profunctors") - (synopsis "Utilities for indexed profunctors") - (description - "This package contains basic definitions related to indexed profunctors. These -are primarily intended as internal utilities to support the @@optics@@ and -@@generic-lens@@ package families.") - (license license:bsd-3))) - -(define ghc-linear-base - (package - (name "ghc-linear-base") - (version "0.3.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "linear-base" version)) - (sha256 - (base32 - "1gm8bwyi39x5x29xb6nq13x9x9p30vm29s11k4pkcql70sj4pv0h")))) - (build-system haskell-build-system) - (properties '((upstream-name . "linear-base"))) - (inputs (list ghc-hashable ghc-linear-generics ghc-storable-tuple ghc-vector - ghc-primitive)) - (native-inputs (list ghc-inspection-testing - ghc-tasty-inspection-testing - ghc-hedgehog - ghc-tasty - ghc-tasty-hedgehog - ghc-mmorph - ghc-tasty - ghc-tasty-hedgehog - ghc-hedgehog)) - (arguments - `(#:cabal-revision ("1" - "153nkw2i7n22xzfj8q2xmzsh77pr7pay8v3gc1xli491qmsc0fcd"))) - (home-page "https://github.com/tweag/linear-base#README") - (synopsis "Standard library for linear types.") - (description "Please see README.md.") - (license license:expat))) - -(define ghc-linear-generics - (package - (name "ghc-linear-generics") - (version "0.2.2") - (source (origin - (method url-fetch) - (uri (hackage-uri "linear-generics" version)) - (sha256 - (base32 - "0ls571qzayky0dax9d209lw9wv344z3969daqcsncv0r5rlvlps9")))) - (build-system haskell-build-system) - (properties '((upstream-name . "linear-generics"))) - (inputs (list ghc-th-abstraction-0.5)) - (native-inputs (list ghc-hspec hspec-discover)) - (home-page "https://github.com/linear-generics/linear-generics") - (synopsis "Generic programming library for generalised deriving.") - (description - "This package offers a version of - -with two important improvements: 1. The @@to@@, @@from@@, @@to1@@, and -@@from1@@ methods have multiplicity-polymorphic types, allowing them to be used -with either traditional Haskell code or linearly typed code. 2. The -representations used for @@Generic1@@ are modified slightly.") - (license license:bsd-3))) - -(define ghc-th-abstraction-0.5 - (package - (inherit ghc-th-abstraction) - (version "0.5.0.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "th-abstraction" version)) - (sha256 - (base32 - "0r4ri85283i1jjhd94wa9nps6cd9a8mh6rr4ds1gb2hqnwxdqn42")))))) + (name "ghc-exit-codes") + (version "1.0.0") + (source + (origin + (method url-fetch) + (uri (hackage-uri "exit-codes" version)) + (sha256 + (base32 "00cyli96zkyqhjr3lqzrislqyk72xwm2dcqvjagklidh32d4k8ja")))) + (build-system haskell-build-system) + (properties '((upstream-name . "exit-codes"))) + (home-page "http://github.com/JustusAdam/exit-codes") + (synopsis "Exit codes as defined by BSD") + (description + "Expose the exit codes defined by BSD in sysexits.h to the Haskell world.") + (license license:bsd-3))) (define ghc-filestore (package - (name "ghc-filestore") - (version "0.6.5.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "filestore" version)) - (sha256 - (base32 - "1m6rav1rcigckakw8ky27lbwh5a9q8xl7nvv358ljykmvyl1j2lc")))) - (build-system haskell-build-system) - (properties '((upstream-name . "filestore"))) - (inputs (list ghc-utf8-string ghc-xml ghc-split ghc-diff ghc-old-locale git mercurial)) - (native-inputs (list ghc-hunit)) - (home-page "http://hackage.haskell.org/package/filestore") - (synopsis "Interface for versioning file stores.") - (description - "The filestore library provides an abstract interface for a versioning file + (name "ghc-filestore") + (version "0.6.5.1") + (source + (origin + (method url-fetch) + (uri (hackage-uri "filestore" version)) + (sha256 + (base32 "1m6rav1rcigckakw8ky27lbwh5a9q8xl7nvv358ljykmvyl1j2lc")))) + (build-system haskell-build-system) + (properties '((upstream-name . "filestore"))) + (inputs (list ghc-utf8-string ghc-xml ghc-split ghc-diff ghc-old-locale)) + (native-inputs (list ghc-hunit git-minimal/pinned mercurial)) + (home-page "http://hackage.haskell.org/package/filestore") + (synopsis "Interface for versioning file stores.") + (description + "The filestore library provides an abstract interface for a versioning file store, and modules that instantiate this interface. Currently Git, Darcs, and Mercurial modules are provided, and other VCSs or databases could be added.") - (license license:bsd-3))) + (license license:bsd-3))) + +(define ghc-generic-data + (package + (name "ghc-generic-data") + (version "1.1.0.2") + (source + (origin + (method url-fetch) + (uri (hackage-uri "generic-data" version)) + (sha256 + (base32 "1dfs728nbkilzfmdk6gnjk7wdk1habqn35pb071zcmcp8ll0lzpj")))) + (build-system haskell-build-system) + (properties '((upstream-name . "generic-data"))) + (inputs (list ghc-ap-normalize ghc-base-orphans ghc-show-combinators + ghc-contravariant)) + (native-inputs (list ghc-generic-lens + ghc-tasty + ghc-tasty-hunit + ghc-one-liner)) + (arguments + `(#:cabal-revision ("1" + "0f2aijk70cb01p8yzbg5jq4gawnaryg8qnb1jx4xx92mfmn673p8"))) + (home-page "https://github.com/Lysxia/generic-data#readme") + (synopsis "Deriving instances with GHC.Generics and related utilities") + (description + "Generic implementations of standard type classes. Operations on generic +representations to help using \"GHC.Generics\". See README.") + (license license:expat))) + +(define ghc-lens-action + (package + (name "ghc-lens-action") + (version "0.2.6") + (source + (origin + (method url-fetch) + (uri (hackage-uri "lens-action" version)) + (sha256 + (base32 "0cdprc5j6r976dmrga2zwvcr7qsv7nqy3nvncp66yyy0dk2qlwm3")))) + (build-system haskell-build-system) + (properties '((upstream-name . "lens-action"))) + (inputs (list ghc-lens ghc-comonad ghc-contravariant ghc-profunctors + ghc-semigroupoids)) + (arguments + `(#:cabal-revision ("2" + "0rrrv7k0fz98j99a6gzw858v5w3i378g0b7ijj30dz2am6p6rfnm"))) + (home-page "http://github.com/ekmett/lens-action/") + (synopsis "Monadic Getters and Folds") + (description + "This package contains combinators and types for working with monadic getters and +folds as split off from the original lens package.") + (license license:bsd-3))) + +(define ghc-linear-base + (package + (name "ghc-linear-base") + (version "0.5.0") + (source + (origin + (method url-fetch) + (uri (hackage-uri "linear-base" version)) + (sha256 + (base32 "0iikqp73i0isxkd8xwg5f8f6dk3cv5iw6ifjkmp5r5kwxb650xgq")))) + (build-system haskell-build-system) + (properties '((upstream-name . "linear-base"))) + (inputs (list ghc-hashable ghc-linear-generics ghc-storable-tuple + ghc-vector ghc-primitive)) + (native-inputs (list ghc-inspection-testing + ghc-tasty-inspection-testing + ghc-tasty + ghc-tasty-hedgehog + ghc-mmorph + ghc-hedgehog)) + (home-page "https://github.com/tweag/linear-base#README") + (synopsis "Standard library for linear types.") + (description "Please see README.md.") + (license license:expat))) + +(define ghc-linear-generics + (package + (name "ghc-linear-generics") + (version "0.2.3") + (source + (origin + (method url-fetch) + (uri (hackage-uri "linear-generics" version)) + (sha256 + (base32 "0093ywl8s8k92b50li28gcmqc616f6l7jkv7vslkvqzn42yrvbq2")))) + (build-system haskell-build-system) + (properties '((upstream-name . "linear-generics"))) + (inputs (list ghc-th-abstraction)) + (native-inputs (list hspec-discover ghc-hspec)) + (arguments + `(#:cabal-revision ("4" + "1wxb2r70bn1rhs771jlq08q1wvaf7risn6y931snaxa0xwi6a4zq"))) + (home-page "https://github.com/linear-generics/linear-generics") + (synopsis "Generic programming library for generalised deriving.") + (description + "This package offers a version of + +with two important improvements: . 1. The @@to@@, @@from@@, @@to1@@, and +@@from1@@ methods have multiplicity-polymorphic types, allowing them to be used +with either traditional Haskell code or linearly typed code. . 2. The +representations used for @@Generic1@@ are modified slightly. As a result, +@@to1@@ and @@from1@@ never need to use @@fmap@@. This can +, +and it is . A smaller change, approximately +, reduces +the number of instances that must be written to actually use @@Generic1@@ for +deriving instances of other classes. . For more details, see the +\"Generics.Linear\" documentation. . The implementation is based on the +@@generic-deriving@@ package, first described in the paper . * /A generic +deriving mechanism for Haskell/. Jose Pedro Magalhaes, Atze Dijkstra, Johan +Jeuring, and Andres Loeh. Haskell'10. . This library is organized as follows: +. * \"Generics.Linear\" defines the core functionality for generics, including the +multiplicity-polymorphic @@Generic(1)@@ classes and a replacement for the +@@:.:@@ composition type. . * \"Generics.Linear.TH\" implements Template Haskell +functionality for deriving instances of @@Generic(1)@@. . * +\"Generics.Linear.Unsafe.@code{ViaGHCGenerics}\" offers @code{@@DerivingVia}@@ +targets to derive @@Generic@@ and @@Generic1@@ instances from +@@\"GHC.Generics\".'GHC.Generics.Generic'@@. Because these instances necessarily +use unsafe coercions, their use will likely inhibit full optimization of code +using them. . Educational code: the educational modules exported by + have +been copied into the @@tests\\/Generic\\/Deriving@@ directory in this repository, +with the very few modifications required to accommodate the differences between +the @@Generic1@@ representations here and in @@base@@. All the same caveats +apply as in the originals; see that package's @@README@@.") + (license license:bsd-3))) + +(define ghc-one-liner + (package + (name "ghc-one-liner") + (version "2.1") + (source + (origin + (method url-fetch) + (uri (hackage-uri "one-liner" version)) + (sha256 + (base32 "09gdivd38disddxs42179vmgca0yzk5dfm6ygicgl5l25qbizrfh")))) + (build-system haskell-build-system) + (properties '((upstream-name . "one-liner"))) + (inputs (list ghc-contravariant ghc-bifunctors ghc-profunctors ghc-tagged + ghc-linear-base)) + (native-inputs (list ghc-hunit)) + (arguments + `(#:cabal-revision ("1" + "1n6d74s0x91qi4fi6wv5yggjb1nvwk0ir580mkf67bca2x6f1cqn"))) + (home-page "https://github.com/sjoerdvisscher/one-liner") + (synopsis "Constraint-based generics") + (description + "Write short and concise generic instances of type classes. one-liner is +particularly useful for writing default implementations of type class methods.") + (license license:bsd-3))) (define ghc-purebred-email (package - (name "ghc-purebred-email") - (version "0.6.0.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "purebred-email" version)) - (sha256 - (base32 - "0gdzdbxgsyps8hqd903bsyja0cr6kbklkicvma62q48wv0y7230j")))) - (build-system haskell-build-system) - (properties '((upstream-name . "purebred-email"))) - (inputs (list ghc-attoparsec - ghc-case-insensitive - ghc-lens - ghc-base64-bytestring - ghc-concise - ghc-random - ghc-semigroupoids - ghc-stringsearch)) - (native-inputs (list ghc-tasty - ghc-tasty-hedgehog - ghc-tasty-quickcheck - ghc-tasty-hunit - ghc-tasty-golden - ghc-hedgehog - ghc-quickcheck-instances)) - (home-page "https://github.com/purebred-mua/purebred-email") - (synopsis "types and parser for email messages (including MIME)") - (description + (name "ghc-purebred-email") + (version "0.7") + (source + (origin + (method url-fetch) + (uri (hackage-uri "purebred-email" version)) + (sha256 + (base32 "1rw72rjji7bclql975gqpbisapjgzzywydql6p6b1v0ivzpsaq3s")))) + (build-system haskell-build-system) + (properties '((upstream-name . "purebred-email"))) + (inputs (list ghc-attoparsec + ghc-case-insensitive + ghc-lens + ghc-base64-bytestring + ghc-concise + ghc-random + ghc-semigroupoids + ghc-stringsearch)) + (native-inputs (list ghc-tasty + ghc-tasty-hedgehog + ghc-tasty-quickcheck + ghc-tasty-hunit + ghc-tasty-golden + ghc-hedgehog + ghc-quickcheck-instances)) + (home-page "https://github.com/purebred-mua/purebred-email") + (synopsis "types and parser for email messages (including MIME)") + (description "The purebred email library. RFC 5322, MIME, etc. See \"Data.MIME\" for usage, examples and API documentation. . This is a general-purpose library for processing and constructing email messages, originally written to meet the needs @@ -533,48 +412,110 @@ and forward/bounce - Content transfer and charset decoding/encoding - MIME message header extensions for non-ASCII text () - MIME parameter value and encoded word extensions () - -@@Content-Disposition@@ header field () - Address syntax in @@From@@ and @@Sender@@ fields - ()") - (license license:agpl3+))) +@@Content-Disposition@@ header field () - Address syntax in @@From@@ and @@Sender@@ fields +() - @@Author@@ header field +().") + (license license:agpl3+))) -(define ghc-concise +(define ghc-safecopy (package - (name "ghc-concise") - (version "0.1.0.1") - (source (origin - (method url-fetch) - (uri (hackage-uri "concise" version)) - (sha256 - (base32 - "09crgc6gjfidlad6263253xx1di6wfhc9awhira21s0z7rddy9sw")))) - (build-system haskell-build-system) - (properties '((upstream-name . "concise"))) - (inputs (list ghc-lens)) - (native-inputs (list ghc-tasty ghc-tasty-quickcheck ghc-quickcheck - ghc-quickcheck-instances)) - (home-page "https://github.com/frasertweedale/hs-concise") - (synopsis "Utilities for Control.Lens.Cons") - (description - "concise provides a handful of functions to extend what you can do with - Control.Lens.Cons.") - (license license:bsd-3))) + (name "ghc-safecopy") + (version "0.10.4.3") + (source + (origin + (method url-fetch) + (uri (hackage-uri "safecopy" version)) + (sha256 + (base32 "03hkb4znm7jaszz290hqal3zbmw3606gafrbdxrvlcfkrpg1m71c")))) + (build-system haskell-build-system) + (properties '((upstream-name . "safecopy"))) + (inputs (list ghc-cereal ghc-generic-data ghc-old-time ghc-vector)) + (native-inputs (list ghc-lens ghc-lens-action ghc-tasty + ghc-tasty-quickcheck ghc-hunit)) + (home-page "https://github.com/acid-state/safecopy") + (synopsis "Binary serialization with version control.") + (description + "An extension to Data.Serialize with built-in version control.") + (license license:public-domain))) -(define ghc-exit-codes +(define ghc-scotty (package - (name "ghc-exit-codes") - (version "1.0.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "exit-codes" version)) - (sha256 - (base32 - "00cyli96zkyqhjr3lqzrislqyk72xwm2dcqvjagklidh32d4k8ja")))) - (build-system haskell-build-system) - (properties '((upstream-name . "exit-codes"))) - (home-page "http://github.com/JustusAdam/exit-codes") - (synopsis "Exit codes as defined by BSD") - (description - "Expose the exit codes defined by BSD in sysexits.h to the Haskell world.") - (license license:bsd-3))) + (name "ghc-scotty") + (version "0.22") + (source + (origin + (method url-fetch) + (uri (hackage-uri "scotty" version)) + (sha256 + (base32 "075qnj3s1ddq337qcbrgwsc12rgjm1g5p755iaf67k824p0rifff")))) + (build-system haskell-build-system) + (properties '((upstream-name . "scotty"))) + (inputs (list ghc-aeson + ghc-blaze-builder + ghc-case-insensitive + ghc-cookie + ghc-data-default-class + ghc-http-types + ghc-monad-control + ghc-network + ghc-regex-compat + ghc-resourcet + ghc-transformers-base + ghc-unliftio + ghc-wai + ghc-wai-extra + ghc-warp + ghc-fail + ghc-nats)) + (native-inputs (list hspec-discover + ghc-async + ghc-hspec + ghc-hspec-wai + ghc-lifted-base + ghc-doctest + ghc-http-client)) + (arguments + `(#:cabal-revision ("2" + "1m3qvb5q6yigw6ijxnp6h66rmyqg54619hb240s7cqc9qjrrkixk"))) + (home-page "https://github.com/scotty-web/scotty") + (synopsis + "Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp") + (description + "This package provides a Haskell web framework inspired by Ruby's Sinatra, using +WAI and Warp. . @@ {-# LANGUAGE @code{OverloadedStrings} #-} . + import Web.Scotty . main = scotty 3000 $ get "/:word" $ do + beam <- @code{pathParam} "word" + html $ mconcat ["<h1>Scotty, ", beam, " +me up!</h1>"] @@ . . Scotty is the cheap and cheerful way to write +RESTful, declarative web applications. . * A page is as simple as defining the +verb, url pattern, and Text content. . * It is template-language agnostic. +Anything that returns a Text value will do. . * Conforms to WAI Application +interface. . * Uses very fast Warp webserver by default. . As for the name: +Sinatra + Warp = Scotty. . [WAI] . +[Warp] .") + (license license:bsd-3))) + +(define ghc-show-combinators + (package + (name "ghc-show-combinators") + (version "0.2.0.0") + (source + (origin + (method url-fetch) + (uri (hackage-uri "show-combinators" version)) + (sha256 + (base32 "07ds87ldl9165hj3k5h84iawc6vqlbggni3dg1nhbxww1spxn0n9")))) + (build-system haskell-build-system) + (properties '((upstream-name . "show-combinators"))) + (arguments + `(#:cabal-revision ("2" + "0n3xlpm41wpw1ybmacg9s7150nx00qrdlw2rq4fzz7iw7333cyjx"))) + (home-page "https://github.com/Lysxia/show-combinators#readme") + (synopsis "Combinators to write Show instances") + (description + "This package provides a minimal pretty-printing library for Show instances in +Haskell.") + (license license:expat))) tiedote-md diff --git a/.guix/patches/ghc-doclayout-add-lift-instance.patch b/.guix/patches/ghc-doclayout-add-lift-instance.patch new file mode 100644 index 0000000..fe2027b --- /dev/null +++ b/.guix/patches/ghc-doclayout-add-lift-instance.patch @@ -0,0 +1,149 @@ +From 8179aba8aa35ac3fa518a2a398b0f66b67092433 Mon Sep 17 00:00:00 2001 +From: Saku Laesvuori +Date: Wed, 5 Aug 2026 10:28:41 +0300 +Subject: [PATCH] Add Template Haskell Lift instance for Doc + +--- + doclayout.cabal | 1 + + src/Text/DocLayout.hs | 4 +++- + src/Text/DocLayout/ANSIFont.hs | 20 +++++++++++--------- + src/Text/DocLayout/Attributed.hs | 6 ++++-- + 4 files changed, 19 insertions(+), 12 deletions(-) + +diff --git a/doclayout.cabal b/doclayout.cabal +index 83ad188..ff3b545 100644 +--- a/doclayout.cabal ++++ b/doclayout.cabal +@@ -32,6 +32,7 @@ library + containers, + emojis >=0.1.2, + mtl, ++ template-haskell-lift, + safe + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-unused-do-bind +diff --git a/src/Text/DocLayout.hs b/src/Text/DocLayout.hs +index d4ff1b3..7c252df 100644 +--- a/src/Text/DocLayout.hs ++++ b/src/Text/DocLayout.hs +@@ -4,6 +4,7 @@ + {-# LANGUAGE DeriveFoldable #-} + {-# LANGUAGE DeriveFunctor #-} + {-# LANGUAGE DeriveGeneric #-} ++{-# LANGUAGE DeriveLift #-} + {-# LANGUAGE DeriveTraversable #-} + {-# LANGUAGE FlexibleInstances #-} + {-# LANGUAGE LambdaCase #-} +@@ -127,6 +128,7 @@ import qualified Data.Text as T + import Data.Text (Text) + import qualified Data.Text.Lazy as TL + import qualified Data.Text.Lazy.Builder as B ++import Language.Haskell.TH.Lift (Lift) + import Text.DocLayout.HasChars + import Text.DocLayout.ANSIFont + import Text.DocLayout.Attributed +@@ -159,7 +161,7 @@ data Doc a = Text Int a -- ^ Text with specified width. + | Linked Text (Doc a) -- ^ A hyperlink + | Empty + deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, +- Data, Typeable, Generic) ++ Data, Typeable, Generic, Lift) + + + instance Semigroup (Doc a) where +diff --git a/src/Text/DocLayout/ANSIFont.hs b/src/Text/DocLayout/ANSIFont.hs +index b952d0b..7002f92 100644 +--- a/src/Text/DocLayout/ANSIFont.hs ++++ b/src/Text/DocLayout/ANSIFont.hs +@@ -1,5 +1,6 @@ + {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE DeriveDataTypeable #-} ++{-# LANGUAGE DeriveLift #-} + module Text.DocLayout.ANSIFont + ( Font(..) + , baseFont +@@ -17,6 +18,7 @@ module Text.DocLayout.ANSIFont + ) where + + import Data.Data (Data) ++import Language.Haskell.TH.Lift (Lift) + import Data.String + import Data.Text (Text) + +@@ -29,18 +31,18 @@ data Font = Font + ftBackground :: Background, + ftLink :: Maybe Text + } +- deriving (Show, Eq, Read, Data, Ord) ++ deriving (Show, Eq, Read, Data, Ord, Lift) + + baseFont :: Font + baseFont = Font Normal Roman ULNone Unstruck FGDefault BGDefault Nothing + +-data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord) +-data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord) +-data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord) +-data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord) +-data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord) +-data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord) +-data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord) ++data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord, Lift) ++data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord, Lift) ++data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord, Lift) ++data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord, Lift) ++data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord, Lift) ++data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord, Lift) ++data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord, Lift) + + data StyleReq + = RWeight Weight +@@ -49,7 +51,7 @@ data StyleReq + | RBackground Background + | RUnderline Underline + | RStrikeout Strikeout +- deriving (Show, Eq, Read, Data, Ord) ++ deriving (Show, Eq, Read, Data, Ord, Lift) + + (~>) :: Font -> StyleReq -> Font + (~>) f (RWeight w) = f{ftWeight = w} +diff --git a/src/Text/DocLayout/Attributed.hs b/src/Text/DocLayout/Attributed.hs +index 46574a1..24124c3 100644 +--- a/src/Text/DocLayout/Attributed.hs ++++ b/src/Text/DocLayout/Attributed.hs +@@ -1,4 +1,5 @@ + {-# LANGUAGE DeriveGeneric #-} ++{-# LANGUAGE DeriveLift #-} + {-# LANGUAGE DeriveTraversable #-} + {-# LANGUAGE DeriveDataTypeable #-} + {-# LANGUAGE FlexibleInstances #-} +@@ -9,6 +10,7 @@ import Data.String + import Text.DocLayout.ANSIFont (Font, baseFont) + import Data.Data (Data, Typeable) + import GHC.Generics ++import Language.Haskell.TH.Lift (Lift) + import Data.Sequence ((><)) + import qualified Data.Sequence as S + import Data.Text (Text) +@@ -18,7 +20,7 @@ type Link = Maybe Text + -- | Font attributes. + data Attr a = Attr Link Font a + deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, +- Data, Typeable, Generic) ++ Data, Typeable, Generic, Lift) + + instance Semigroup a => Semigroup (Attr a) where + (<>) (Attr l f x) (Attr _ _ y) = Attr l f $ x <> y -- This is arbitrary +@@ -29,7 +31,7 @@ instance (IsString a, Monoid a) => Monoid (Attr a) where + -- | A sequence of strings with font attributes. + newtype Attributed a = Attributed (S.Seq (Attr a)) + deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, +- Data, Typeable, Generic) ++ Data, Typeable, Generic, Lift) + + fromList :: [Attr a] -> Attributed a + fromList = Attributed . S.fromList + +base-commit: aa2e9d853b7c26f49d3b540f7ca0625e612503ce +-- +2.54.0 + diff --git a/channels.scm b/channels.scm index ae72b9c..4349294 100644 --- a/channels.scm +++ b/channels.scm @@ -3,7 +3,7 @@ (url "https://git.savannah.gnu.org/git/guix.git") (branch "master") (commit - "b2943f6791d02feda7901c3dc2c777193e664455") + "86813d5779253bb50002d79ab791eeda5a8b4729") (introduction (make-channel-introduction "9edb3f66fd807b096b48283debdcddccfea34bad" diff --git a/src/Main.hs b/src/Main.hs index dcf80ab..18e2807 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,7 +22,7 @@ import System.Directory (findExecutable) import System.Exit (exitWith) import System.Exit.Codes (codeTempFail) import System.Posix.User (getRealUserID, userName, getUserEntryForID) -import Web.Scotty (scotty, post, liftAndCatchIO, defaultHandler) +import Web.Scotty (scotty, post, liftIO, defaultHandler, Handler(Handler), ScottyException) import qualified Data.Text as T import qualified Data.Text.Lazy.IO as LT @@ -41,8 +41,8 @@ serverMain socket mail repoPath origin sendmailPath checkpointDelay port = do _ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid queueMessages acid _ <- forkIO $ scotty port $ do - defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients - post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath origin + defaultHandler $ Handler $ liftIO . (print :: ScottyException -> IO ()) + post "/" $ liftIO $ void $ forkIO $ updateMessages acid repoPath origin updateMessages acid repoPath origin _ <- forkIO $ manageQueueingMessages acid _ <- forkIO $ managePreviews acid mail sendmailPath diff --git a/src/TiedoteMD/Read.hs b/src/TiedoteMD/Read.hs index a3e92f3..1126ce3 100644 --- a/src/TiedoteMD/Read.hs +++ b/src/TiedoteMD/Read.hs @@ -18,6 +18,7 @@ import Data.Bifunctor (first, second) import Data.ByteArray (convert) import Data.ByteString (ByteString) import "base64" Data.ByteString.Base64.URL +import Data.Base64.Types (extractBase64) import Data.Default (def) import Data.Either (rights, lefts, fromRight) import Data.FileStore (FileStore(..), Revision(..), FileStoreError(..), gitFileStore) @@ -128,7 +129,7 @@ readMessageFile store file = retrieve store file Nothing >>= cidOf :: MediaItem -> ContentID cidOf MediaItem {mediaContents, mediaMimeType} = fromRight (error "makeContentID failed with valid input!") $ - makeContentID $ "<" <> encodedHash <> "@tiedote.md.sha256>" + makeContentID $ "<" <> extractBase64 encodedHash <> "@tiedote.md.sha256>" where encodedHash = encodeBase64' $ convert $ hashWith SHA256 $ LBS.toStrict mediaContents <> encodeUtf8 mediaMimeType diff --git a/src/TiedoteMD/Templates/TH.hs b/src/TiedoteMD/Templates/TH.hs index 613c657..2971664 100644 --- a/src/TiedoteMD/Templates/TH.hs +++ b/src/TiedoteMD/Templates/TH.hs @@ -8,7 +8,6 @@ module TiedoteMD.Templates.TH where import Control.Exception (throwIO) import Data.FileEmbed import Language.Haskell.TH.Syntax (Q, Exp, Lift, runIO, lift, Quasi(qAddDependentFile)) -import Text.DocLayout (Doc(..)) import Text.DocTemplates.Internal (Variable(..), Pipe(..), Alignment(..), Border(..), Template(..)) import Text.Pandoc (compileTemplate) @@ -17,7 +16,6 @@ import qualified Data.Text.IO as T import TiedoteMD.Types -deriving instance Lift (Doc T.Text) deriving instance Lift (Template T.Text) deriving instance Lift Alignment deriving instance Lift Border diff --git a/tiedote-md.cabal b/tiedote-md.cabal index 1106559..00ab40c 100644 --- a/tiedote-md.cabal +++ b/tiedote-md.cabal @@ -1,6 +1,6 @@ cabal-version: 3.6 name: tiedote-md -version: 0.0.1 +version: 0.0.2 author: Saku Laesvuori maintainer: saku@laesvuori.fi bug-reports: https://git.olarinmaensamoojat.fi/OMS/tiedote.md/issues @@ -30,7 +30,7 @@ executable tiedote.md bytestring, case-insensitive, containers, - cryptonite, + crypton, data-default, directory, doclayout,