diff options
author | Profpatsch <mail@profpatsch.de> | 2024-07-21 20:51:47 +0200 |
---|---|---|
committer | Profpatsch <mail@profpatsch.de> | 2024-07-21 20:51:47 +0200 |
commit | 267638857e9b28af86cd2c59b5b754abf750deb3 (patch) | |
tree | f658ff06a5c04d68526278aa937ce93686d9f19b | |
parent | c23864e48a84c1a0168bbd6811cd5886165c4bff (diff) |
pkgs/profpatsch/xdg-open: migrate first part to importPurescript
whoa
-rw-r--r-- | pkgs/profpatsch/haskell-overlay.nix | 23 | ||||
-rw-r--r-- | pkgs/profpatsch/importDhall.nix | 17 | ||||
-rw-r--r-- | pkgs/profpatsch/importPurescript.nix | 36 | ||||
-rw-r--r-- | pkgs/profpatsch/purenix-import-fix.patch | 39 | ||||
-rw-r--r-- | pkgs/profpatsch/purenix-purescript-0_15_12.patch | 78 | ||||
-rw-r--r-- | pkgs/profpatsch/purescript-import-fix.patch | 113 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/config.dhall | 13 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/default.nix | 93 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/.gitignore | 2 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/.vscode/settings.json | 5 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.js | 5 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.nix | 8 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.purs | 166 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/shell.nix | 10 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/types.dhall | 3 |
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 |