pkgs/profpatsch/xdg-open: migrate first part to importPurescript

whoa

15 files changed, 543 insertions, 68 deletions

diff --git a/pkgs/profpatsch/haskell-overlay.nix b/pkgs/profpatsch/haskell-overlay.nix
new file mode 100644
index 00000000..69ca4a95
--- /dev/null
+++ b/pkgs/profpatsch/haskell-overlay.nix
@@ -0,0 +1,23 @@
+pkgs:
+
+let hlib = pkgs.haskell.lib.compose;
+
+in {
+  haskellPackages = pkgs.haskellPackages.override {
+    overrides = self: super: {
+
+      # https://github.com/NixOS/nixpkgs/pull/328896
+      purescript = pkgs.lib.pipe super.purescript [
+        (hlib.appendPatches [./purescript-import-fix.patch ])
+        hlib.unmarkBroken
+      ];
+      purenix = pkgs.lib.pipe super.purenix [
+        (hlib.appendPatches [
+          ./purenix-import-fix.patch
+          ./purenix-purescript-0_15_12.patch
+        ])
+        hlib.unmarkBroken
+      ];
+    };
+  };
+}
diff --git a/pkgs/profpatsch/importDhall.nix b/pkgs/profpatsch/importDhall.nix
index 4334be3c..88e785ad 100644
--- a/pkgs/profpatsch/importDhall.nix
+++ b/pkgs/profpatsch/importDhall.nix
@@ -8,6 +8,7 @@ let
   # unions values are nix functions that take a record of match
   # functions for their alternatives.
   importDhall = dhallType: file: importDhall2 {
+    name = "dhall-to-nix";
     root = builtins.dirOf file;
     files = [];
     main = builtins.baseNameOf file;
@@ -16,7 +17,7 @@ let
   };
 
   # TODO: document
-  importDhall2 = { root, files, main, deps, type }:
+  importDhall2 = { name, root, files, main, deps, type ? null }:
     let
       src =
         exactSource
@@ -29,7 +30,7 @@ let
       cache = ".cache";
       cacheDhall = "${cache}/dhall";
 
-      convert = pkgs.runCommandLocal "dhall-to-nix" { inherit deps; } ''
+      convert = pkgs.runCommandLocal "${name}-dhall-to-nix" { inherit deps; } ''
         mkdir -p ${cacheDhall}
         for dep in $deps; do
           ${pkgs.xorg.lndir}/bin/lndir -silent $dep/${cacheDhall} ${cacheDhall}
@@ -39,9 +40,15 @@ let
         # go into the source directory, so that the type can import files.
         # TODO: This is a bit of a hack hrm.
         cd "${src}"
-        printf '%s' ${pkgs.lib.escapeShellArg "${src}/${main} : ${type}"} \
-          | ${pkgs.dhall-nix}/bin/dhall-to-nix \
-          > $out
+        ${if type != null then ''
+            printf '%s' ${pkgs.lib.escapeShellArg "${src}/${main} : ${type}"} \
+              | ${pkgs.dhall-nix}/bin/dhall-to-nix \
+              > $out
+          '' else ''
+            printf '%s' ${pkgs.lib.escapeShellArg "${src}/${main}"} \
+              | ${pkgs.dhall-nix}/bin/dhall-to-nix \
+              > $out
+          ''}
       '';
     in import convert;
 
diff --git a/pkgs/profpatsch/importPurescript.nix b/pkgs/profpatsch/importPurescript.nix
new file mode 100644
index 00000000..fb3617ed
--- /dev/null
+++ b/pkgs/profpatsch/importPurescript.nix
@@ -0,0 +1,36 @@
+{ pkgs, exactSource }:
+let
+
+  # import the purescript file as nix expression via purenix.
+  # Converts the purescript output to a nix file structure
+  # puts it in the store and imports it.
+  # Types are erased, functions are converted to nix functions,
+  # unions values are TODO.
+  importPurescript = { name, root, files, mainModule }:
+    let
+      src =
+        exactSource
+          root
+          # exactSource wants nix paths, but I think relative paths
+          # as strings are more intuitive.
+          (let abs = path: toString root + "/" + path;
+           in map abs files);
+
+      mainPath = pkgs.lib.replaceStrings ["."] ["/"] mainModule;
+
+      convert = pkgs.runCommandLocal "${name}-purs-to-nix" { } ''
+        export LC_ALL=C.UTF-8
+        ${pkgs.purescript}/bin/purs compile --codegen corefn '${src}/**/*.purs'
+        # converts everything in the ./output dir to nix
+        ${pkgs.purenix}/bin/purenix
+
+        mkdir -p $out
+        cp -r ./output/* $out
+      '';
+    in import "${convert}/${mainPath}";
+
+in {
+  inherit
+    importPurescript
+    ;
+}
diff --git a/pkgs/profpatsch/purenix-import-fix.patch b/pkgs/profpatsch/purenix-import-fix.patch
new file mode 100644
index 00000000..5fb897f6
--- /dev/null
+++ b/pkgs/profpatsch/purenix-import-fix.patch
@@ -0,0 +1,39 @@
+From f1890690264e7e5ce7f5b0a32d73d910ce2cbd73 Mon Sep 17 00:00:00 2001
+From: Profpatsch <mail@profpatsch.de>
+Date: Sun, 21 Jul 2024 16:08:34 +0200
+Subject: [PATCH] Fix imports for new mtl
+
+mtl decided to un-export `Control.Monad` and `Data.Monoid`, which in
+itself is fine, but of course it breaks everything.
+---
+ src/PureNix/Convert.hs | 1 +
+ src/PureNix/Main.hs    | 1 +
+ 2 files changed, 2 insertions(+)
+
+diff --git a/src/PureNix/Convert.hs b/src/PureNix/Convert.hs
+index 83ff2d7..33b767a 100644
+--- a/src/PureNix/Convert.hs
++++ b/src/PureNix/Convert.hs
+@@ -5,6 +5,7 @@
+ 
+ module PureNix.Convert (convert, ModuleInfo (..)) where
+ 
++import Control.Monad
+ import Data.Bitraversable
+ import qualified Data.Map as M
+ import Data.Set (Set)
+diff --git a/src/PureNix/Main.hs b/src/PureNix/Main.hs
+index d393d8b..0ec3272 100644
+--- a/src/PureNix/Main.hs
++++ b/src/PureNix/Main.hs
+@@ -17,6 +17,7 @@ import qualified System.Exit as Sys
+ import System.FilePath ((</>))
+ import qualified System.FilePath as FP
+ import System.IO
++import Control.Monad
+ 
+ defaultMain :: IO ()
+ defaultMain = do
+-- 
+2.44.1
+
diff --git a/pkgs/profpatsch/purenix-purescript-0_15_12.patch b/pkgs/profpatsch/purenix-purescript-0_15_12.patch
new file mode 100644
index 00000000..376e42aa
--- /dev/null
+++ b/pkgs/profpatsch/purenix-purescript-0_15_12.patch
@@ -0,0 +1,78 @@
+From 2dae563f887c7c8daf3dd3e292ee3580cb70d528 Mon Sep 17 00:00:00 2001
+From: Profpatsch <mail@profpatsch.de>
+Date: Tue, 26 Dec 2023 17:41:08 +0100
+Subject: [PATCH 1/2] chore: adjust to purescript 0.15.12 corefn changes
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Some of the constructors changed shape, but that shouldn’t influence
+purenix very much.
+---
+ src/PureNix/Convert.hs | 8 ++++----
+ src/PureNix/Expr.hs    | 9 ++++++++-
+ 2 files changed, 12 insertions(+), 5 deletions(-)
+
+diff --git a/src/PureNix/Convert.hs b/src/PureNix/Convert.hs
+index 8034580..83ff2d7 100644
+--- a/src/PureNix/Convert.hs
++++ b/src/PureNix/Convert.hs
+@@ -54,7 +54,7 @@ localSpan :: SourceSpan -> Convert a -> Convert a
+ localSpan spn = local (fmap $ const spn)
+ 
+ localAnn :: Ann -> Convert a -> Convert a
+-localAnn (spn, _, _, _) = localSpan spn
++localAnn (spn,  _, _) = localSpan spn
+ 
+ {-# ANN module' ("hlint: ignore Use list comprehension" :: String) #-}
+ module' ::
+@@ -106,7 +106,7 @@ expr :: Expr Ann -> Convert N.Expr
+ expr (Abs ann arg body) = localAnn ann $ fmap (N.lam (N.mkVar arg)) (expr body)
+ expr (Literal ann lit) = localAnn ann $ literal lit
+ -- Newtype wrappers can always be removed.
+-expr (App ann (Var (_, _, _, Just IsNewtype) _) x) = localAnn ann (expr x)
++expr (App ann (Var ( _, _, Just IsNewtype) _) x) = localAnn ann (expr x)
+ expr (App ann f x) = localAnn ann $ liftA2 N.app (expr f) (expr x)
+ expr (Var ann (P.Qualified mqual name)) = localAnn ann $ do
+   (_, thisModule, _) <- ask
+@@ -116,7 +116,7 @@ expr (Var ann (P.Qualified mqual name)) = localAnn ann $ do
+     _ -> N.var (N.mkVar name)
+ expr (Accessor ann sel body) = localAnn ann $ flip N.sel (N.stringKey sel) <$> expr body
+ expr (Let ann binds body) = localAnn ann $ liftA2 N.let' (bindings binds) (expr body)
+-expr (ObjectUpdate ann a b) = localAnn ann $ liftA2 (N.bin N.Update) (expr a) (attrs b)
++expr (ObjectUpdate ann a _ b ) = localAnn ann $ liftA2 (N.bin N.Update) (expr a) (attrs b)
+ expr (Constructor _ _ (P.ProperName dataName) fields) = pure $ N.constructor dataName (N.mkVar <$> fields)
+ expr (Case ann exprs cases) =
+   localAnn ann $ do
+@@ -171,7 +171,7 @@ zipBinders exprs binds = mconcat <$> zipWithM unbinder binds exprs
+ unbinder :: Binder Ann -> N.Expr -> Convert ([N.Expr], [(N.Var, N.Expr)])
+ unbinder (NullBinder _) _ = pure mempty
+ unbinder (VarBinder _ name) scrut = pure $ (\name' -> ([], [(name', scrut)])) $ N.mkVar name
+-unbinder (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [field]) scrut = unbinder field scrut
++unbinder (ConstructorBinder ( _, _, Just IsNewtype) _ _ [field]) scrut = unbinder field scrut
+ unbinder (ConstructorBinder ann _ (P.Qualified _ (P.ProperName tag)) fields) scrut =
+   localAnn ann $
+     mappend ([N.bin N.Equals (N.sel scrut "__tag") (N.string tag)], []) . mconcat <$> zipWithM (\binder field -> unbinder binder (N.sel scrut field)) fields (N.numberedKeys "__field")
+diff --git a/src/PureNix/Expr.hs b/src/PureNix/Expr.hs
+index 6a8dab7..234240a 100644
+--- a/src/PureNix/Expr.hs
++++ b/src/PureNix/Expr.hs
+@@ -47,7 +47,14 @@ data ExprF f
+   | Path Text
+   deriving stock (Functor, Foldable, Traversable, Show)
+ 
+-data Op = Update | Equals | And
++-- | Nix binary operators
++data Op =
++  -- | nix @//@ operator (right-side keys overwrite left side attrset)
++  Update |
++  -- | nix @==@ operator (equality)
++  Equals |
++  -- | nix @&&@ operator (boolean @and@)
++  And
+   deriving (Eq, Show)
+ 
+ foldExpr :: (ExprF r -> r) -> Expr -> r
+-- 
+2.44.1
+
diff --git a/pkgs/profpatsch/purescript-import-fix.patch b/pkgs/profpatsch/purescript-import-fix.patch
new file mode 100644
index 00000000..aa948457
--- /dev/null
+++ b/pkgs/profpatsch/purescript-import-fix.patch
@@ -0,0 +1,113 @@
+diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs
+index f0b6711..987023c 100644
+--- a/app/Command/Docs.hs
++++ b/app/Command/Docs.hs
+@@ -6,7 +6,7 @@ import Prelude
+ import Command.Docs.Html (asHtml, writeHtmlModules)
+ import Command.Docs.Markdown (asMarkdown, writeMarkdownModules)
+ import Control.Applicative (Alternative(..), optional)
+-import Control.Monad.Writer (when)
++import Control.Monad (when)
+ import Control.Monad.Trans.Except (runExceptT)
+ import Data.Maybe (fromMaybe)
+ import Data.Text qualified as T
+diff --git a/app/Command/Docs/Html.hs b/app/Command/Docs/Html.hs
+index 6ad5104..116cf0f 100644
+--- a/app/Command/Docs/Html.hs
++++ b/app/Command/Docs/Html.hs
+@@ -9,7 +9,7 @@ import Prelude
+ 
+ import Control.Applicative (Alternative(..))
+ import Control.Arrow ((&&&))
+-import Control.Monad.Writer (guard)
++import Control.Monad (guard)
+ import Data.List (sort)
+ import Data.Text (Text)
+ import Data.Text.Lazy (toStrict)
+diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs
+index 8c64fd2..dd447a9 100644
+--- a/src/Control/Monad/Supply.hs
++++ b/src/Control/Monad/Supply.hs
+@@ -7,7 +7,8 @@ import Prelude
+ 
+ import Control.Applicative (Alternative)
+ import Control.Monad.Error.Class (MonadError(..))
+-import Control.Monad.Reader (MonadPlus, MonadReader, MonadTrans)
++import Control.Monad.Reader (MonadReader, MonadTrans)
++import Control.Monad (MonadPlus)
+ import Control.Monad.State (StateT(..))
+ import Control.Monad.Writer (MonadWriter)
+ 
+diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
+index 56d962b..6a15c36 100644
+--- a/src/Language/PureScript/Errors.hs
++++ b/src/Language/PureScript/Errors.hs
+@@ -13,7 +13,8 @@ import Control.Lens (both, head1, over)
+ import Control.Monad (forM, unless)
+ import Control.Monad.Error.Class (MonadError(..))
+ import Control.Monad.Trans.State.Lazy (State, evalState, get, put)
+-import Control.Monad.Writer (Last(..), MonadWriter(..), censor)
++import Control.Monad.Writer (MonadWriter(..), censor)
++import Data.Monoid (Last(..))
+ import Data.Bifunctor (first, second)
+ import Data.Bitraversable (bitraverse)
+ import Data.Char (isSpace)
+diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs
+index a54e39f..aff42ca 100644
+--- a/src/Language/PureScript/Renamer.hs
++++ b/src/Language/PureScript/Renamer.hs
+@@ -5,7 +5,8 @@ module Language.PureScript.Renamer (renameInModule) where
+ 
+ import Prelude
+ 
+-import Control.Monad.State (MonadState(..), State, gets, modify, runState, (>=>))
++import Control.Monad.State (MonadState(..), State, gets, modify, runState)
++import Control.Monad ((>=>))
+ 
+ import Data.Functor ((<&>))
+ import Data.List (find)
+diff --git a/src/Language/PureScript/Sugar/Operators/Common.hs b/src/Language/PureScript/Sugar/Operators/Common.hs
+index 1a18f88..7fd6df9 100644
+--- a/src/Language/PureScript/Sugar/Operators/Common.hs
++++ b/src/Language/PureScript/Sugar/Operators/Common.hs
+@@ -2,7 +2,7 @@ module Language.PureScript.Sugar.Operators.Common where
+ 
+ import Prelude
+ 
+-import Control.Monad.State (guard, join)
++import Control.Monad (guard, join)
+ import Control.Monad.Except (MonadError(..))
+ 
+ import Data.Either (rights)
+diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
+index 7a3872c..85bdfee 100644
+--- a/src/Language/PureScript/TypeChecker/Entailment.hs
++++ b/src/Language/PureScript/TypeChecker/Entailment.hs
+@@ -15,9 +15,11 @@ import Protolude (ordNub, headMay)
+ 
+ import Control.Arrow (second, (&&&))
+ import Control.Monad.Error.Class (MonadError(..))
+-import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, foldM, gets, guard, join, modify, zipWithM, zipWithM_, (<=<))
++import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, gets, modify)
++import Control.Monad (foldM, guard, join, zipWithM, zipWithM_, (<=<))
+ import Control.Monad.Supply.Class (MonadSupply(..))
+-import Control.Monad.Writer (Any(..), MonadWriter(..), WriterT(..))
++import Control.Monad.Writer (MonadWriter(..), WriterT(..))
++import Data.Monoid (Any(..))
+ 
+ import Data.Either (lefts, partitionEithers)
+ import Data.Foldable (for_, fold, toList)
+diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs
+index ba27d02..b6382e6 100644
+--- a/src/Language/PureScript/TypeChecker/Monad.hs
++++ b/src/Language/PureScript/TypeChecker/Monad.hs
+@@ -9,7 +9,8 @@ import Prelude
+ 
+ import Control.Arrow (second)
+ import Control.Monad.Error.Class (MonadError(..))
+-import Control.Monad.State (MonadState(..), StateT(..), forM_, gets, guard, join, modify, when, (<=<))
++import Control.Monad.State (MonadState(..), StateT(..), gets, modify)
++import Control.Monad (forM_, guard, join, when, (<=<))
+ import Control.Monad.Writer.Class (MonadWriter(..), censor)
+ 
+ import Data.Maybe (fromMaybe)
diff --git a/pkgs/profpatsch/xdg-open/config.dhall b/pkgs/profpatsch/xdg-open/config.dhall
index 72cb109c..48343620 100644
--- a/pkgs/profpatsch/xdg-open/config.dhall
+++ b/pkgs/profpatsch/xdg-open/config.dhall
@@ -39,7 +39,7 @@ in  λ(pkgs : { package : Text, binary : Text } → Executable) →
                     , args =
                         λ(template : Arg) →
                             wrapper.args template
-                          # [ Arg.String cmd.exe ]
+                          # [ Arg.string cmd.exe ]
                           # cmd.args template
                     }
 
@@ -61,10 +61,6 @@ in  λ(pkgs : { package : Text, binary : Text } → Executable) →
                     }
                   , xml =
                     { mime = [ "text", "xml" ], cmd = special.open-in-browser }
-                  , ical =
-                    { mime = [ "text", "calendar" ]
-                    , cmd = special.add-to-calendar
-                    }
                   , csv =
                     { mime = [ "text", "csv" ]
                     , cmd = oneArg (pkgSameOnDemand "libreoffice")
@@ -110,9 +106,9 @@ in  λ(pkgs : { package : Text, binary : Text } → Executable) →
                     { exe = pkgs { package = "gnupg", binary = "gpg" }
                     , args =
                         λ(file : Arg) →
-                          [ Arg.String "--import"
-                          , Arg.String "--import-options"
-                          , Arg.String "show-only"
+                          [ Arg.string "--import"
+                          , Arg.string "--import-options"
+                          , Arg.string "show-only"
                           , file
                           ]
                     }
@@ -144,7 +140,6 @@ in  λ(pkgs : { package : Text, binary : Text } → Executable) →
             , mime.text.gemini
             , mime.text.gopher
             , mime.text.xml
-            , mime.text.ical
             , mime.text.csv
             , mime.text.any
             , mime.mail-address
diff --git a/pkgs/profpatsch/xdg-open/default.nix b/pkgs/profpatsch/xdg-open/default.nix
index f10e13a6..a79f1d40 100644
--- a/pkgs/profpatsch/xdg-open/default.nix
+++ b/pkgs/profpatsch/xdg-open/default.nix
@@ -1,5 +1,6 @@
 { pkgs, getBins, tvl,
 importDhall2,
+importPurescript,
 writeExecline,
 buildDhallPackage,
 runExeclineLocal,
@@ -7,7 +8,8 @@ writeRustSimple,
 netencode-rs,
 record-get,
 el-exec,
-lazy-packages
+lazy-packages,
+show-qr-code
 }:
 
 let
@@ -26,6 +28,7 @@ let
       // getBins pkgs.firefox [ "firefox" ]
       // getBins pkgs.ranger [ "ranger" ]
       // getBins pkgs.khal [ "khal" ]
+      // getBins show-qr-code [ "show-qr-code" ]
       ;
 
   notify = msg: {
@@ -34,7 +37,7 @@ let
             ("\${1} \${2}")
           ];
     args = file: [
-      ({String, Variable}: String msg)
+      ({string, variable}: string msg)
       file
     ];
   };
@@ -54,24 +57,17 @@ let
     args = file: [ file ];
   };
 
-  # TODO: interactive adding? Don’t want to add all ics files to my calendar
-  add-to-calendar = {
-    exe = writeExecline "add-to-calendar" { readNArgs = 1; } [
-      "if" [
-        bins.khal
-          "import"
-          "--batch"
-          # the private calendar is called calendar
-          "--include-calendar" "calendar"
-          "$1"
-      ]
-      "systemctl" "--user"
-        "start"
-        # defined as a user service (TODO: config variable?)
-        "calendar-sync"
-    ];
-    args = file: [ file ];
-  };
+  # show as qr code so I can import it with the google camera QR code reader!!!
+  # add-to-calendar = {
+  #   exe = writeExecline "ics-to-qr-code" { readNArgs = 1; } [
+  #     "pipeline" [
+  #       tvl.users.Profpatsch.ical-smolify "$1"
+  #     ]
+  #     # show contents of ics as qr code
+  #     bins.show-qr-code
+  #   ];
+  #   args = file: [ file ];
+  # };
 
   open-in-browser = {
     exe = bins.firefox;
@@ -97,8 +93,8 @@ let
   exec-in-terminal-emulator = {exe, args}: {
     exe = tvl.users.Profpatsch.alacritty;
     args = file: [
-      ({Variable, String}: String "--execute")
-      ({Variable, String}: String exe)
+      ({variable, string}: string "--execute")
+      ({variable, string}: string exe)
     ] ++ args file;
   };
 
@@ -123,34 +119,11 @@ let
       code = "${src.repo}/${src.mainFile}";
     };
 
-  xdg-open = importDhall2 {
-      type = ''
-  let Command = { args : < String : Text | Variable : Text >
-                  → List < String : Text | Variable : Text >
-                , exe : Text }
-  in
-  ∀(bins : { get-mime-type : Text })
-→ ∀(write-dash : Text → Text → Text)
-→ ∀(shellEscape : Text → Text)
-→ ∀(pkgs : { binary : Text, package : Text } → Text)
-→ ∀(pkgsOnDemand : { binary : Text, package : Text } → Text)
-→ ∀ ( special
-    : { compose-mail-to : Command
-      , dmenu-list-binaries-and-exec : Command
-      , exec-in-terminal-emulator : ∀ ( args: Command) → Command
-      , fetch-http-url-mime : Command
-      , open-in-browser : Command
-      , open-in-editor : Command
-      , notify : Text -> Command
-      , add-to-calendar : Command
-      }
-    )
-→ Text
-      '';
+  xdg-open-config = importDhall2 {
+      name = "xdg-open-config";
       root = ./.;
-      main = "xdg-open.dhall";
+      main = "config.dhall";
       files = [
-        "config.dhall"
         "types.dhall"
         "imports/Prelude/Text/concatSep"
         "imports/Prelude/Text/concatMap"
@@ -160,9 +133,6 @@ let
       ];
       deps = [ Prelude ];
     }
-    { inherit get-mime-type; }
-    pkgs.writers.writeDash
-    pkgs.lib.escapeShellArg
     ({binary, package}: "${lib.getBin pkgs.${package}}/bin/${binary}")
     ({binary, package}: "${lazy-packages.mkWrapper {
       package = (lib.getBin pkgs.${package});
@@ -177,10 +147,27 @@ let
         dmenu-list-binaries-and-exec
         exec-in-terminal-emulator
         notify
-        add-to-calendar
+        # add-to-calendar
         ;
     };
 
+  xdg-open-module = importPurescript {
+      name = "xdg-open-module";
+      root = ./purs;
+
+      mainModule = "XdgOpen";
+      files = [
+        "XdgOpen.purs"
+        "XdgOpen.nix"
+      ];
+    };
+
+  xdg-open = xdg-open-module.main {
+    writeDash = pkgs.writers.writeDash;
+    uriMimeGlobs = xdg-open-config.uriMimeGlobs;
+    orderedMimeMatchers = xdg-open-config.orderedMimeMatchers;
+  };
+
   httparse = pkgs.buildRustCrate {
     pname = "httparse";
     version = "1.3.4";
@@ -314,6 +301,8 @@ let
 in {
   inherit
     xdg-open
+    xdg-open-module
+    xdg-open-config
     Prelude
     read-headers-and-follow-redirect
     mini-url
diff --git a/pkgs/profpatsch/xdg-open/purs/.gitignore b/pkgs/profpatsch/xdg-open/purs/.gitignore
new file mode 100644
index 00000000..0f7e23f9
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/.gitignore
@@ -0,0 +1,2 @@
+/output/
+/.psc-ide-port
diff --git a/pkgs/profpatsch/xdg-open/purs/.vscode/settings.json b/pkgs/profpatsch/xdg-open/purs/.vscode/settings.json
new file mode 100644
index 00000000..901baffb
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/.vscode/settings.json
@@ -0,0 +1,5 @@
+{
+    "purescript.buildCommand": "purs compile --codegen corefn --json-errors **/*.purs",
+    "purescript.exportsCodeLens": false,
+    "editor.formatOnSave": true
+}
diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.js b/pkgs/profpatsch/xdg-open/purs/XdgOpen.js
new file mode 100644
index 00000000..4edf476b
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.js
@@ -0,0 +1,5 @@
+export function nixpkgs(){}
+export function lib(){}
+export function appendString(){}
+export function appendArray(){}
+export function builtinThrow(){}
diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix b/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix
new file mode 100644
index 00000000..509bcdee
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix
@@ -0,0 +1,8 @@
+rec {
+  # TODO: use nixpkgs from packageset
+  nixpkgs = import <nixpkgs> {};
+  lib = nixpkgs.lib;
+  appendString = s: s2: s + s2;
+  appendArray = a: a2: a ++ a2;
+  builtinThrow = msg: throw msg;
+}
diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs b/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs
new file mode 100644
index 00000000..986e4f33
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs
@@ -0,0 +1,166 @@
+module XdgOpen where
+
+data Drv
+type Executable = String
+
+foreign import nixpkgs :: { hello :: Drv }
+foreign import lib
+  :: { map :: forall a b. (a -> b) -> Array a -> Array b
+     , concatMap :: forall a b. (a -> Array b) -> Array a -> Array b
+     , concatStringsSep :: String -> Array String -> String
+     , concatStrings :: Array String -> String
+     , concatMapStrings :: (String -> String) -> Array String -> String
+     , genList :: forall a. (Int -> a) -> Int -> Array a
+     }
+
+foreign import appendString :: String -> String -> String
+foreign import appendArray :: forall a. Array a -> Array a -> Array a
+foreign import builtinThrow :: forall a. String -> a
+
+throw :: forall a. String -> a
+throw = builtinThrow
+
+todo :: forall a. a
+todo = builtinThrow "TODO: Unimplemented"
+
+infixl 1 appendString as +
+infixl 1 appendArray as ++
+
+renderMime ∷ Array String → String
+renderMime = lib.concatStringsSep "/"
+
+repeatText :: Int -> String -> String
+repeatText n s = lib.concatStrings (lib.genList (\_ -> s) n)
+
+type Lines = { indent :: Int, lines :: Array String }
+
+-- | Pretty print the line array with its indent.
+prettyLines :: Lines -> String
+prettyLines lines = lib.concatMapStrings (\line -> (lib.concatStrings [ repeatText lines.indent " ", line, "\n" ])) lines.lines
+
+type Mime = Array String
+
+type Arg = forall r. { string :: String -> r, variable :: String -> r } -> r
+
+type CommandTemplate templates =
+  { exe :: Executable, args :: templates → Array Arg }
+
+-- Given an executable and args to pass to the executable,
+-- which might be a bash variable or a simple command line string.
+-- Should remove that indirection at some point and just generate execline strings/scripts instead. (?)
+type Command =
+  CommandTemplate Arg
+
+type MimeMatch = { mime :: Mime, cmd :: Command }
+
+-- | Escape the given shell command, at least the String arguments of it.
+-- Passes `$file` as variable argument.
+-- The final shell command is executed into.
+shellEscapeExecCommand :: (String -> String) -> String -> Command -> String
+shellEscapeExecCommand shellEscape file cmd =
+  lib.concatStringsSep " "
+    ( [ "exec", shellEscape cmd.exe ] ++ lib.map
+        ( \(arg :: Arg) ->
+            arg { string: \t -> shellEscape t, variable: \t -> t }
+        )
+        (cmd.args (\{ variable } -> variable file))
+    )
+
+mimeMatcherCase :: (String -> String) -> String -> MimeMatch -> Array String
+mimeMatcherCase shellEscape file m =
+  [ renderMime m.mime + ")"
+  , shellEscapeExecCommand shellEscape file m.cmd
+  , ";;"
+  ]
+
+type UriMimeGlob =
+  { desc :: String
+  , -- less specific than glob, used by firefox to refer to the schema
+    schemaPrefix :: Array String
+  , -- schema shell glob to check whether a link corresponds to the schema
+    glob :: Array String
+  , handler :: MimeMatch
+  }
+
+mimeGlobCase :: (String -> String) -> String -> UriMimeGlob -> Array String
+mimeGlobCase shellEscape file g = lib.concatMap
+  ( \(match :: String) ->
+      [ match + ")"
+      , shellEscapeExecCommand shellEscape file g.handler.cmd
+      , ";;"
+      ]
+  )
+  g.glob
+
+-- type Special =
+--   { openInEditor :: Command
+--   , openInBrowser :: Command
+--   , fetchHttpUrlMime :: Command
+--   , composeMailTo :: Command
+--   , execInTerminalEmulator :: Command -> Command
+--   , dmenuListBinariesAndExec :: Command
+--   , notify :: String → Command
+--   }
+
+type Config =
+  { uriMimeGlobs :: Array UriMimeGlob
+  , orderedMimeMatchers :: Array MimeMatch
+  }
+
+xdgOpen
+  :: (String -> String -> Executable)
+  -> (String -> String)
+  -> Config
+  -> Executable
+xdgOpen writeDash shellEscape config = writeDash "xdg-open"
+  ( lib.concatStringsSep "\n"
+      [
+        -- partially taken from
+        -- https://github.com/march-linux/mimi/blob/master/xdg-open
+        "set -e"
+      , "file=$1"
+      , "mime="
+      ,
+        -- TODO: --dry-run to display what would be opened and why
+        "notify-send --expire-time=500 -- \\\"xdg-open: $1\\\""
+      , "# match on protocols; if you want to match files reliably, start with file://"
+      , "case \\\"$file\\\" in"
+      , prettyLines
+          { indent: 2
+          , lines: lib.concatMap (mimeGlobCase shellEscape "\\\"$file\\\"") config.uriMimeGlobs
+          }
+      , "*)"
+      , "  # it’s a file"
+      , "  # strip possible protocol"
+      , "  file=\\${file#file://}"
+      , "  mime=$(file -E --brief --mime-type \\\"$file\\\") \\\\"
+      , "    || (echo \\\"$mime\\\" 1>&2; exit 1)"
+      , "  # ^ echo the error message of file"
+      , "  ;;"
+      , "esac"
+      , ""
+      , "case \\\"$mime\\\" in"
+      , prettyLines
+          { indent: 2
+          , lines: lib.concatMap (mimeMatcherCase shellEscape "\\\"$file\\\"") config.orderedMimeMatchers
+
+          }
+      , "esac"
+      ]
+
+  )
+
+type Opts =
+  { uriMimeGlobs :: Array UriMimeGlob
+  , orderedMimeMatchers :: Array MimeMatch
+  , writeDash :: String -> String -> String
+  }
+
+main
+  :: Opts
+  -> String
+main opts = xdgOpen opts.writeDash (\txt -> txt)
+  { uriMimeGlobs: opts.uriMimeGlobs
+  , orderedMimeMatchers:
+      opts.orderedMimeMatchers
+  }
diff --git a/pkgs/profpatsch/xdg-open/purs/shell.nix b/pkgs/profpatsch/xdg-open/purs/shell.nix
new file mode 100644
index 00000000..5ce15149
--- /dev/null
+++ b/pkgs/profpatsch/xdg-open/purs/shell.nix
@@ -0,0 +1,10 @@
+{ pkgs ? import <nixpkgs> {} }:
+
+pkgs.mkShell {
+  buildInputs = [
+    pkgs.pulp
+    pkgs.purescript
+    pkgs.purenix
+    pkgs.nodePackages.purs-tidy
+  ];
+}
diff --git a/pkgs/profpatsch/xdg-open/types.dhall b/pkgs/profpatsch/xdg-open/types.dhall
index 8cc033b4..27fd8141 100644
--- a/pkgs/profpatsch/xdg-open/types.dhall
+++ b/pkgs/profpatsch/xdg-open/types.dhall
@@ -5,7 +5,7 @@ let
     Executable =
       Text
 
-let Arg = < String : Text | Variable : Text >
+let Arg = < string : Text | variable : Text >
 
 let CommandTemplate =
       λ(templates : Type) → { exe : Executable, args : templates → List Arg }
@@ -25,7 +25,6 @@ let Special =
       , exec-in-terminal-emulator : ∀(args : Command) → Command
       , dmenu-list-binaries-and-exec : Command
       , notify : ∀(message : Text) → Command
-      , add-to-calendar : Command
       }
 
 let