diff options
-rw-r--r-- | pkgs/profpatsch/default.nix | 30 | ||||
-rw-r--r-- | pkgs/profpatsch/dhall/build-dhall-package-improved.nix | 69 | ||||
-rw-r--r-- | pkgs/profpatsch/importDhall.nix | 73 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/config.dhall | 203 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/default.nix | 107 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/Config.purs | 181 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/Main.purs | 63 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.js | 1 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.nix | 4 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/purs/XdgOpen.purs | 39 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/types.dhall | 52 | ||||
-rw-r--r-- | pkgs/profpatsch/xdg-open/xdg-open.dhall | 145 | ||||
-rw-r--r-- | pkgs/profpatsch/xmonad/DhallTypedInput.hs | 232 |
13 files changed, 308 insertions, 891 deletions
diff --git a/pkgs/profpatsch/default.nix b/pkgs/profpatsch/default.nix index 3aacd051..10864b39 100644 --- a/pkgs/profpatsch/default.nix +++ b/pkgs/profpatsch/default.nix @@ -3,6 +3,12 @@ let inherit (pkgs) callPackage; + pkgsWithNewHaskell = import (import ../../nixpkgs-path.nix) { + config = { + packageOverrides = import ./haskell-overlay.nix; + }; + }; + # Takes a derivation and a list of binary names # and returns an attribute set of `name -> path`. # The list can also contain renames in the form of @@ -239,35 +245,21 @@ in rec { - # dhall-flycheck = (import /home/philip/kot/dhall/flycheck/overlay.nix pkgs pkgs).dhall-flycheck; - - # FIXME: removed 2021-06-13 since it doesn't evaluate with the unstable channel anymore - # dhall-flycheck = - # (import "${pkgs.fetchFromGitHub { - # owner = "Profpatsch"; - # repo = "dhall-flycheck"; - # rev = "2ace6b38cec356d8821b3390b670d301d54623b"; - # sha256 = "0d6qjr245jmx1lvqdplvrshlkpfaqa46aizyhyb6hg37v8jq8rv7"; - # }}/overlay.nix" pkgs pkgs).dhall-flycheck; - - buildDhallPackage = pkgs.callPackage ./dhall/build-dhall-package-improved.nix { }; - - inherit (import ./importDhall.nix { inherit pkgs exactSource; }) - importDhall - importDhall2 - readDhallFileAsJson + inherit (import ./importPurescript.nix { inherit exactSource; pkgs = pkgsWithNewHaskell; }) + importPurescript ; rust-deps = (import ./rust-deps.nix { inherit (pkgs) buildRustCrate; }); - inherit (import ./xdg-open { inherit pkgs tvl getBins importDhall2 writeExecline buildDhallPackage runExeclineLocal netencode-rs writeRustSimple record-get el-exec lazy-packages; }) + inherit (import ./xdg-open { inherit pkgs tvl getBins importPurescript writeExecline runExeclineLocal netencode-rs writeRustSimple record-get el-exec lazy-packages show-qr-code; }) xdg-open - Prelude + xdg-open-module read-headers-and-follow-redirect mini-url assert-printf as-stdin printenv + nix ; text-letter = import ./text-letter.nix { inherit pkgs rust-deps writeRustSimple writeExecline getBins; }; diff --git a/pkgs/profpatsch/dhall/build-dhall-package-improved.nix b/pkgs/profpatsch/dhall/build-dhall-package-improved.nix deleted file mode 100644 index 861d8aa0..00000000 --- a/pkgs/profpatsch/dhall/build-dhall-package-improved.nix +++ /dev/null @@ -1,69 +0,0 @@ -# simplified version of build-dhall-package.nix in nixpkgs -# In particular, this keeps the full dhall cache instead of -# just the outermost cache of the fully evaluated package. -# That makes it possible to e.g. just import one function from -# the dhall prelude instead of the whole Prelude, which speeds up -# evaluation considerably (since dhall evaluation is not lazy). -{ haskell, dhall, lib, lndir, runCommand, writeText }: - -{ name - - # Expressions to add to the cache before interpreting the code -, dependencies ? [] - - # A Dhall expression - # - # Carefully note that the following expression must be devoid of uncached HTTP - # imports. This is because the expression will be evaluated using an - # interpreter with HTTP support disabled, so all HTTP imports have to be - # protected by an integrity check that can be satisfied via cached - # dependencies. - # - # You can add a dependency to the cache using the preceding `dependencies` - # option -, code - - # `buildDhallPackage` can include both a "source distribution" in - # `source.dhall` and a "binary distribution" in `binary.dhall`: - # - # * `source.dhall` is a dependency-free αβ-normalized Dhall expression - # - # * `binary.dhall` is an expression of the form: `missing sha256:${HASH}` - # - # This expression requires you to install the cache product located at - # `.cache/dhall/1220${HASH}` to successfully resolve - # - # By default, `buildDhallPackage` only includes "binary.dhall" to conserve - # space within the Nix store, but if you set the following `source` option to - # `true` then the package will also include `source.dhall`. -, source ? false -}: - -let - - file = writeText "${name}.dhall" code; - - cache = ".cache"; - - cacheDhall = "${cache}/dhall"; - -in - runCommand name { inherit dependencies; } '' - set -eu - - mkdir -p $out/${cacheDhall} - - for dependency in $dependencies; do - ${lndir}/bin/lndir -silent $dependency/${cacheDhall} $out/${cacheDhall} - done - - export XDG_CACHE_HOME=$out/${cache} - - ${dhall}/bin/dhall --alpha --file '${file}' > alpha.dhall - - SHA_HASH=$(${dhall}/bin/dhall hash --file alpha.dhall) - - HASH_FILE="''${SHA_HASH/sha256:/1220}" - - ${dhall}/bin/dhall encode --file alpha.dhall > $out/${cacheDhall}/$HASH_FILE - '' diff --git a/pkgs/profpatsch/importDhall.nix b/pkgs/profpatsch/importDhall.nix deleted file mode 100644 index 88e785ad..00000000 --- a/pkgs/profpatsch/importDhall.nix +++ /dev/null @@ -1,73 +0,0 @@ -{ pkgs, exactSource }: -let - - # import the dhall file as nix expression via dhall-nix. - # Converts the normalized dhall expression to a nix file, - # puts it in the store and imports it. - # Types are erased, functions are converted to nix functions, - # 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; - type = dhallType; - deps = []; - }; - - # TODO: document - importDhall2 = { name, root, files, main, deps, type ? null }: - 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 ([ (abs main) ] ++ (map abs files))); - - cache = ".cache"; - cacheDhall = "${cache}/dhall"; - - 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} - done - - export XDG_CACHE_HOME=$(pwd)/${cache} - # go into the source directory, so that the type can import files. - # TODO: This is a bit of a hack hrm. - cd "${src}" - ${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; - - - # read dhall file in as JSON, then import as nix expression. - # The dhall file must not try to import from non-local URLs! - readDhallFileAsJson = dhallType: file: - let - convert = pkgs.runCommandLocal "dhall-to-json" {} '' - printf '%s' ${pkgs.lib.escapeShellArg "${file} : ${dhallType}"} \ - | ${pkgs.dhall-json}/bin/dhall-to-json \ - > $out - ''; - in builtins.fromJSON (builtins.readFile convert); - -in { - inherit - importDhall - importDhall2 - readDhallFileAsJson - ; -} diff --git a/pkgs/profpatsch/xdg-open/config.dhall b/pkgs/profpatsch/xdg-open/config.dhall deleted file mode 100644 index 48343620..00000000 --- a/pkgs/profpatsch/xdg-open/config.dhall +++ /dev/null @@ -1,203 +0,0 @@ -let types = ./types.dhall - -let Executable = types.Executable - -let Special = types.Special - -let Command = types.Command - -let Arg = types.Arg - -let Mime = types.Mime - -let UriMimeGlob = types.UriMimeGlob - -let MimeMatch = types.MimeMatch - -in λ(pkgs : { package : Text, binary : Text } → Executable) → - λ(pkgsOnDemand : { package : Text, binary : Text } → Executable) → - λ(special : Special) → - let mime = - let pkgSame = - λ(packageAndBinaryName : Text) → - pkgs - { package = packageAndBinaryName - , binary = packageAndBinaryName - } - - let pkgSameOnDemand = - λ(packageAndBinaryName : Text) → - pkgsOnDemand - { package = packageAndBinaryName - , binary = packageAndBinaryName - } - - let wrapCommand = - λ(wrapper : Command) → - λ(cmd : Command) → - { exe = wrapper.exe - , args = - λ(template : Arg) → - wrapper.args template - # [ Arg.string cmd.exe ] - # cmd.args template - } - - let - -- An executable that takes as its one argument the file to run - oneArg = - λ(exe : Executable) → { exe, args = λ(file : Arg) → [ file ] } - - in { text = - { html = - { mime = [ "text", "html" ], cmd = special.open-in-browser } - , gemini = - { mime = [ "text", "gemini" ] - , cmd = oneArg (pkgSame "lagrange") - } - , gopher = - { mime = [ "text", "gopher" ] - , cmd = oneArg (pkgSame "lagrange") - } - , xml = - { mime = [ "text", "xml" ], cmd = special.open-in-browser } - , csv = - { mime = [ "text", "csv" ] - , cmd = oneArg (pkgSameOnDemand "libreoffice") - } - , any = - { mime = [ "text", "any" ], cmd = special.open-in-editor } - } - , mail-address = - { mime = [ "special", "mailaddress" ] - , cmd = special.compose-mail-to - } - , torrent = - { mime = [ "application", "x-bittorrent" ] - , cmd = special.notify "No xdg-open handler for the torrent" - } - , irc = - { mime = [ "x-scheme-handler", "irc" ] - , cmd = special.notify "No xdg-open handler for the irc link" - } - , file = - { mime = [ "x-scheme-handler", "file" ] - , cmd = - special.notify - "No xdg-open handler for the x-scheme-handler/file" - } - , image = - { gif = - { mime = [ "image", "gif" ], cmd = special.open-in-browser } - , svg = - { mime = [ "image", "svg+xml" ] - , cmd = oneArg (pkgSame "inkscape") - } - , any = - { mime = [ "image", "*" ], cmd = oneArg (pkgSame "imv") } - } - , pdf = - { mime = [ "application", "pdf" ] - , cmd = oneArg (pkgSame "zathura") - } - , pgp-key = - { mime = [ "application", "pgp-keys" ] - , cmd = - { exe = pkgs { package = "gnupg", binary = "gpg" } - , args = - λ(file : Arg) → - [ Arg.string "--import" - , Arg.string "--import-options" - , Arg.string "show-only" - , file - ] - } - } - , directory = - { mime = [ "inode", "directory" ] - , cmd = - special.exec-in-terminal-emulator - (oneArg (pkgSame "ranger")) - } - , opendocument-any = - { mime = [ "application/vnd.oasis.opendocument.*" ] - , cmd = oneArg (pkgSameOnDemand "libreoffice") - } - , openxmlformats-any = - { mime = [ "application/vnd.openxmlformats-officedocument.*" ] - , cmd = oneArg (pkgSameOnDemand "libreoffice") - } - , msword = - { mime = [ "application/msword" ] - , cmd = oneArg (pkgSameOnDemand "libreoffice") - } - , any = - { mime = [ "*" ], cmd = special.dmenu-list-binaries-and-exec } - } - - let orderedMimeMatchers = - [ mime.text.html - , mime.text.gemini - , mime.text.gopher - , mime.text.xml - , mime.text.csv - , mime.text.any - , mime.mail-address - , mime.torrent - , mime.irc - , mime.file - , mime.image.gif - , mime.image.svg - , mime.image.any - , mime.pdf - , mime.opendocument-any - , mime.openxmlformats-any - , mime.pgp-key - , mime.directory - , mime.any - ] - - let uriMimeGlobs - : List UriMimeGlob - = [ { desc = "http link" - , glob = [ "http://*", "https://*" ] - , schema-prefix = [ "http", "https" ] - , handler = mime.text.html - } - , { desc = "gemini link" - , glob = [ "gemini://*" ] - , schema-prefix = [ "gemini" ] - , handler = mime.text.gemini - } - , { desc = "gemini link" - , glob = [ "gopher://*", "gophers://*" ] - , schema-prefix = [ "gopher", "gophers" ] - , handler = mime.text.gopher - } - , { glob = [ "mailto:*" ] - , desc = "mail address" - , schema-prefix = [ "mailto" ] - , handler = mime.mail-address - } - , { glob = [ "magnet:*" ] - , desc = "bittorrent magnet link" - , schema-prefix = [ "magnet" ] - , handler = mime.torrent - } - , { desc = "irc channel" - , glob = [ "irc:*", "ircs:*" ] - , schema-prefix = [ "irc", "ircs" ] - , handler = mime.irc - } - ] - - in { uriMimeGlobs - , UriMimeGlob - , orderedMimeMatchers - , Executable - , Command - , MimeMatch - , Special - , Mime - , Arg - } diff --git a/pkgs/profpatsch/xdg-open/default.nix b/pkgs/profpatsch/xdg-open/default.nix index a79f1d40..72f2622f 100644 --- a/pkgs/profpatsch/xdg-open/default.nix +++ b/pkgs/profpatsch/xdg-open/default.nix @@ -1,8 +1,6 @@ { pkgs, getBins, tvl, -importDhall2, importPurescript, writeExecline, -buildDhallPackage, runExeclineLocal, writeRustSimple, netencode-rs, @@ -42,11 +40,11 @@ let ]; }; - get-mime-type = writeExecline "get-mime-type" { readNArgs = 1; } [ + getMimeType = writeExecline "get-mime-type" { readNArgs = 1; } [ bins.file "-E" "--brief" "--mime-type" "$1" ]; - compose-mail-to = { + composeMailTo = { exe = writeExecline "emacs-mail" { readNArgs = 1; } [ bins.emacsclient "--create-frame" @@ -69,17 +67,17 @@ let # args = file: [ file ]; # }; - open-in-browser = { + openInBrowser = { exe = bins.firefox; args = file: [ file ]; }; - open-in-editor = { + openInEditor = { exe = bins.emacsclient; args = file: [ file ]; }; - dmenu-list-binaries-and-exec = { + dmenuListBinariesAndExec = { exe = writeExecline "dmenu-query" { readNArgs = 1; } [ "backtick" "-in" "cmd" [ "pipeline" [ bins.dmenu_path ] bins.dmenu @@ -90,7 +88,7 @@ let args = file: [ file ]; }; - exec-in-terminal-emulator = {exe, args}: { + execInTerminalEmulator = {exe, args}: { exe = tvl.users.Profpatsch.alacritty; args = file: [ ({variable, string}: string "--execute") @@ -98,11 +96,11 @@ let ] ++ args file; }; - fetch-command-on-demand = cmd: lazy-packages.mkWrapper { + fetchCommandOnDemand = cmd: lazy-packages.mkWrapper { package = cmd; }; - fetch-http-url-mime = { + fetchHttpUrlMime = { exe = writeExecline "fetch-http-url-mime" { readNArgs = 1; } [ "pipeline" [ read-headers-and-follow-redirect "$1" ] record-get [ "content-type" ] @@ -111,63 +109,44 @@ let args = file: [ file ]; }; - Prelude = - let src = (import ./imports.nix { inherit pkgs; }).Prelude; - # TODO: bs, make dhall version overridable - in buildDhallPackage { - name = "Prelude"; - code = "${src.repo}/${src.mainFile}"; - }; - - xdg-open-config = importDhall2 { - name = "xdg-open-config"; - root = ./.; - main = "config.dhall"; - files = [ - "types.dhall" - "imports/Prelude/Text/concatSep" - "imports/Prelude/Text/concatMap" - "imports/Prelude/Text/concat" - "imports/Prelude/List/map" - "imports/Prelude/List/concatMap" - ]; - deps = [ Prelude ]; - } - ({binary, package}: "${lib.getBin pkgs.${package}}/bin/${binary}") - ({binary, package}: "${lazy-packages.mkWrapper { - package = (lib.getBin pkgs.${package}); - }}/bin/${binary}") - { - inherit - compose-mail-to - open-in-browser - fetch-http-url-mime - fetch-command-on-demand - open-in-editor - dmenu-list-binaries-and-exec - exec-in-terminal-emulator - notify - # add-to-calendar - ; - }; + xdg-open-module = (importPurescript { + name = "xdg-open-module"; + root = ./purs; - xdg-open-module = importPurescript { - name = "xdg-open-module"; - root = ./purs; + mainModule = "Main"; + files = [ + "Main.purs" + "XdgOpen.purs" + "XdgOpen.nix" + "Config.purs" + ]; + }); - mainModule = "XdgOpen"; - files = [ - "XdgOpen.purs" - "XdgOpen.nix" - ]; + xdg-open = xdg-open-module.main + { + writeDash = pkgs.writers.writeDash; + escapeShellArg = pkgs.lib.escapeShellArg; + pkgs = { + pkg = ({binary, package}: "${lib.getBin pkgs.${package}}/bin/${binary}"); + pkgOnDemand = ({binary, package}: "${lazy-packages.mkWrapper { + package = (lib.getBin pkgs.${package}); + }}/bin/${binary}"); + }; + special = { + inherit + composeMailTo + openInBrowser + fetchHttpUrlMime + fetchCommandOnDemand + openInEditor + dmenuListBinariesAndExec + execInTerminalEmulator + notify + # add-to-calendar + ; + }; }; - 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"; @@ -302,8 +281,6 @@ in { inherit xdg-open xdg-open-module - xdg-open-config - Prelude read-headers-and-follow-redirect mini-url assert-printf diff --git a/pkgs/profpatsch/xdg-open/purs/Config.purs b/pkgs/profpatsch/xdg-open/purs/Config.purs new file mode 100644 index 00000000..eb0f94b0 --- /dev/null +++ b/pkgs/profpatsch/xdg-open/purs/Config.purs @@ -0,0 +1,181 @@ +module Config where + +import XdgOpen + +type Special cmd = + { openInEditor :: cmd + , openInBrowser :: cmd + , fetchHttpUrlMime :: cmd + , composeMailTo :: cmd + , execInTerminalEmulator :: cmd -> cmd + , dmenuListBinariesAndExec :: cmd + , notify :: String → cmd + } + +type DrvBinary = { package :: String, binary :: String } +type Pkgs = { pkg :: DrvBinary -> Executable, pkgOnDemand :: DrvBinary -> Executable } + +wrapCommand :: Command -> Command -> Command +wrapCommand wrapper cmd = + { exe: wrapper.exe + , args: \(template :: Arg) -> + wrapper.args + template ++ [ ArgString cmd.exe ] ++ cmd.args template + } + +oneArg :: Executable -> Command +oneArg exe = { exe, args: \(file :: Arg) -> [ file ] } + +mime :: Pkgs -> Special Command -> Config +mime pkgs special = do + let + pkgSame :: String -> Executable + pkgSame name = pkgs.pkg { package: name, binary: name } + + pkgSameOnDemand :: String -> Executable + pkgSameOnDemand name = pkgs.pkgOnDemand { package: name, binary: name } + + let + m = + { text: + { html: { mime: [ "text", "html" ], cmd: special.openInBrowser } + , gemini: + { mime: [ "text", "gemini" ] + , cmd: oneArg (pkgSame "lagrange") + } + , gopher: + { mime: [ "text", "gopher" ] + , cmd: oneArg (pkgSame "lagrange") + } + , xml: + { mime: [ "text", "xml" ], cmd: special.openInBrowser } + , csv: + { mime: [ "text", "csv" ] + , cmd: oneArg (pkgSameOnDemand "libreoffice") + } + , any: + { mime: [ "text", "any" ], cmd: special.openInEditor } + + } + , mailAddress: + { mime: [ "special", "mailaddress" ] + , cmd: special.composeMailTo + } + , torrent: + { mime: [ "application", "x-bittorrent" ] + , cmd: special.notify "No xdg-open handler for the torrent" + } + , irc: + { mime: [ "x-scheme-handler", "irc" ] + , cmd: special.notify "No xdg-open handler for the irc link" + } + , file: + { mime: [ "x-scheme-handler", "file" ] + , cmd: + special.notify + "No xdg-open handler for the x-scheme-handler/file" + } + , image: + { gif: + { mime: [ "image", "gif" ], cmd: special.openInBrowser } + , svg: + { mime: [ "image", "svg+xml" ] + , cmd: oneArg (pkgSame "inkscape") + } + , any: + { mime: [ "image", "*" ], cmd: oneArg (pkgSame "imv") } + } + , pdf: + { mime: [ "application", "pdf" ] + , cmd: oneArg (pkgSame "zathura") + } + , pgpKey: + { mime: [ "application", "pgp-keys" ] + , cmd: + { exe: pkgs.pkg { package: "gnupg", binary: "gpg" } + , args: + \(file :: Arg) -> + [ ArgString "--import" + , ArgString "--import-options" + , ArgString "show-only" + , file + ] + } + } + , directory: + { mime: [ "inode", "directory" ] + , cmd: + special.execInTerminalEmulator + (oneArg (pkgSame "ranger")) + } + , opendocumentAny: + { mime: [ "application/vnd.oasis.opendocument.*" ] + , cmd: oneArg (pkgSameOnDemand "libreoffice") + } + , openxmlformatsAny: + { mime: [ "application/vnd.openxmlformats-officedocument.*" ] + , cmd: oneArg (pkgSameOnDemand "libreoffice") + } + , msword: + { mime: [ "application/msword" ] + , cmd: oneArg (pkgSameOnDemand "libreoffice") + } + , any: + { mime: [ "*" ], cmd: special.dmenuListBinariesAndExec } + } + { orderedMimeMatchers: + [ m.text.html + , m.text.gemini + , m.text.gopher + , m.text.xml + , m.text.csv + , m.text.any + , m.mailAddress + , m.torrent + , m.irc + , m.file + , m.image.gif + , m.image.svg + , m.image.any + , m.pdf + , m.opendocumentAny + , m.openxmlformatsAny + , m.pgpKey + , m.directory + , m.any + ] + , uriMimeGlobs: + [ { desc: "http link" + , glob: [ "http://*", "https://*" ] + , schemaPrefix: [ "http", "https" ] + , handler: m.text.html + } + , { desc: "gemini link" + , glob: [ "gemini://*" ] + , schemaPrefix: [ "gemini" ] + , handler: m.text.gemini + } + , { desc: "gemini link" + , glob: [ "gopher://*", "gophers://*" ] + , schemaPrefix: [ "gopher", "gophers" ] + , handler: m.text.gopher + } + , { glob: [ "mailto:*" ] + , desc: "mail address" + , schemaPrefix: [ "mailto" ] + , handler: m.mailAddress + } + , { glob: [ "magnet:*" ] + , desc: "bittorrent magnet link" + , schemaPrefix: [ "magnet" ] + , handler: m.torrent + } + , { desc: "irc channel" + , glob: [ "irc:*", "ircs:*" ] + , schemaPrefix: [ "irc", "ircs" ] + , handler: m.irc + } + ] :: Array UriMimeGlob + + } + diff --git a/pkgs/profpatsch/xdg-open/purs/Main.purs b/pkgs/profpatsch/xdg-open/purs/Main.purs new file mode 100644 index 00000000..479e6715 --- /dev/null +++ b/pkgs/profpatsch/xdg-open/purs/Main.purs @@ -0,0 +1,63 @@ +module Main where + +import Config +import XdgOpen (Arg(..), Command, CommandTemplate, lib, xdgOpen) + +type ArgR r = { string :: String -> r, variable :: String -> r } -> r +type Command2 = CommandTemplate (ArgR Arg) + +type Opts = + { writeDash :: String -> String -> String + , escapeShellArg :: String -> String + , pkgs :: Pkgs + , special :: Special Command2 + } + +main :: Opts -> String +main opts = + xdgOpen opts.writeDash opts.escapeShellArg (mime opts.pkgs (special2ToSpecial opts.special)) + +command2ToCommand :: Command2 -> Command +command2ToCommand cmd2 = + { exe: cmd2.exe + , args: + let + conv = convArg + in + \arg -> lib.map conv.arg2ToArg (cmd2.args (conv.argToArg2 arg)) + } + +commandToCommand2 :: Command -> Command2 +commandToCommand2 cmd = + { exe: cmd.exe + , args: + let + conv = convArg + in + \arg2 -> lib.map conv.argToArg2 (cmd.args (conv.arg2ToArg arg2)) + } + +convArg :: { arg2ToArg :: ArgR Arg -> Arg, argToArg2 :: Arg -> ArgR Arg } +convArg = + { arg2ToArg: \arg2 -> + arg2 + { string: \t -> ArgString t + , variable: \t -> ArgVariable t + } + , argToArg2: \arg -> case arg of + ArgString t -> \{ string } -> string t + ArgVariable t -> \{ variable } -> variable t + + } + +special2ToSpecial :: Special Command2 -> Special Command +special2ToSpecial special = + { openInEditor: command2ToCommand special.openInEditor + , openInBrowser: command2ToCommand special.openInBrowser + , fetchHttpUrlMime: command2ToCommand special.fetchHttpUrlMime + , composeMailTo: command2ToCommand special.composeMailTo + , execInTerminalEmulator: \cmd -> command2ToCommand (special.execInTerminalEmulator (commandToCommand2 cmd)) + , dmenuListBinariesAndExec: command2ToCommand special.dmenuListBinariesAndExec + , notify: \str -> command2ToCommand (special.notify str) + } + diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.js b/pkgs/profpatsch/xdg-open/purs/XdgOpen.js index 4edf476b..0d16507d 100644 --- a/pkgs/profpatsch/xdg-open/purs/XdgOpen.js +++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.js @@ -1,4 +1,3 @@ -export function nixpkgs(){} export function lib(){} export function appendString(){} export function appendArray(){} diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix b/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix index 509bcdee..c9bc0326 100644 --- a/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix +++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.nix @@ -1,6 +1,8 @@ -rec { +let # TODO: use nixpkgs from packageset nixpkgs = import <nixpkgs> {}; + +in { lib = nixpkgs.lib; appendString = s: s2: s + s2; appendArray = a: a2: a ++ a2; diff --git a/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs b/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs index 986e4f33..c87830eb 100644 --- a/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs +++ b/pkgs/profpatsch/xdg-open/purs/XdgOpen.purs @@ -3,7 +3,6 @@ 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 @@ -40,10 +39,12 @@ prettyLines lines = lib.concatMapStrings (\line -> (lib.concatStrings [ repeatTe type Mime = Array String -type Arg = forall r. { string :: String -> r, variable :: String -> r } -> r +data Arg + = ArgString String + | ArgVariable String type CommandTemplate templates = - { exe :: Executable, args :: templates → Array Arg } + { exe :: Executable, args :: templates → Array templates } -- Given an executable and args to pass to the executable, -- which might be a bash variable or a simple command line string. @@ -60,10 +61,11 @@ 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 } + ( \(arg :: Arg) -> case arg of + ArgString t -> shellEscape t + ArgVariable t -> t ) - (cmd.args (\{ variable } -> variable file)) + (cmd.args (ArgVariable file)) ) mimeMatcherCase :: (String -> String) -> String -> MimeMatch -> Array String @@ -92,16 +94,6 @@ mimeGlobCase shellEscape file g = lib.concatMap ) 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 @@ -149,18 +141,3 @@ xdgOpen writeDash shellEscape config = writeDash "xdg-open" ] ) - -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/types.dhall b/pkgs/profpatsch/xdg-open/types.dhall deleted file mode 100644 index 27fd8141..00000000 --- a/pkgs/profpatsch/xdg-open/types.dhall +++ /dev/null @@ -1,52 +0,0 @@ -let Mime = List Text - -let - -- TODO use library like with shell commands - Executable = - Text - -let Arg = < string : Text | variable : Text > - -let CommandTemplate = - λ(templates : Type) → { exe : Executable, args : templates → List Arg } - -let - -- 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. (?) - Command = - CommandTemplate Arg - -let Special = - { open-in-editor : Command - , open-in-browser : Command - , fetch-http-url-mime : Command - , compose-mail-to : Command - , exec-in-terminal-emulator : ∀(args : Command) → Command - , dmenu-list-binaries-and-exec : Command - , notify : ∀(message : Text) → Command - } - -let - -- describes the command `cmd` to run for the matched mime type `mime` - MimeMatch = - { mime : Mime, cmd : Command } - -let UriMimeGlob = - { desc : Text - , -- less specific than glob, used by firefox to refer to the schema - schema-prefix : List Text - , -- schema shell glob to check whether a link corresponds to the schema - glob : List Text - , handler : MimeMatch - } - -in { Mime - , Executable - , Arg - , CommandTemplate - , Command - , Special - , UriMimeGlob - , MimeMatch - } diff --git a/pkgs/profpatsch/xdg-open/xdg-open.dhall b/pkgs/profpatsch/xdg-open/xdg-open.dhall deleted file mode 100644 index 3d412309..00000000 --- a/pkgs/profpatsch/xdg-open/xdg-open.dhall +++ /dev/null @@ -1,145 +0,0 @@ -let Text/concatSep = ./imports/Prelude/Text/concatSep - -let Text/concatMap = ./imports/Prelude/Text/concatMap - -let List/concatMap = ./imports/Prelude/List/concatMap - -let List/map = ./imports/Prelude/List/map - -let - -- TODO use library like with shell commands - Executable = - Text - -let types = ./types.dhall - -let renderMime = Text/concatSep "/" - -let - -- 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 = - λ(shellEscape : Text → Text) → - λ(file : Text) → - λ(cmd : types.Command) → - Text/concatSep - " " - ( [ "exec", shellEscape cmd.exe ] - # List/map - types.Arg - Text - ( λ(arg : types.Arg) → - merge - { String = λ(t : Text) → shellEscape t - , Variable = λ(t : Text) → t - } - arg - ) - (cmd.args (types.Arg.Variable file)) - ) - : Text - -let repeatText = - λ(t : Text) → - λ(n : Natural) → - Natural/fold n Text (λ(t2 : Text) → t ++ t2) "" - -let Lines = { indent : Natural, lines : List Text } - -let prettyLines = - λ(lines : Lines) → - Text/concatMap - Text - (λ(line : Text) → repeatText " " lines.indent ++ line ++ "\n") - lines.lines - -let xdg-open = - let mimeMatcherCase = - λ(shellEscape2 : Text → Text) → - λ(file2 : Text) → - λ(m : types.MimeMatch) → - [ "${renderMime m.mime})" - , "${shellEscapeExecCommand shellEscape2 file2 m.cmd}" - , ";;" - ] - - let mimeGlobCase = - λ(shellEscape2 : Text → Text) → - λ(file2 : Text) → - λ(g : types.UriMimeGlob) → - List/concatMap - Text - Text - ( λ(match : Text) → - [ "${match})" - , shellEscapeExecCommand shellEscape2 file2 g.handler.cmd - , ";;" - ] - ) - g.glob - : List Text - - in λ(bins : { get-mime-type : Executable }) → - λ(write-dash : Text → Text → Executable) → - λ(shellEscape : Text → Text) → - λ(pkgs : { package : Text, binary : Text } → Executable) → - λ(pkgsOnDemand : { package : Text, binary : Text } → Executable) → - λ(special : types.Special) → - let config = ./config.dhall pkgs pkgsOnDemand special - - in write-dash - "xdg-open" - ( '' - - # 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 = - List/concatMap - types.UriMimeGlob - Text - (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 = - List/concatMap - types.MimeMatch - Text - (mimeMatcherCase shellEscape "\"\$file\"") - config.orderedMimeMatchers - }} - esac - '' - ) - -in xdg-open diff --git a/pkgs/profpatsch/xmonad/DhallTypedInput.hs b/pkgs/profpatsch/xmonad/DhallTypedInput.hs deleted file mode 100644 index 18c32b22..00000000 --- a/pkgs/profpatsch/xmonad/DhallTypedInput.hs +++ /dev/null @@ -1,232 +0,0 @@ -{-# language RecordWildCards, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, KindSignatures, DataKinds, ScopedTypeVariables, RankNTypes, GADTs, TypeApplications, AllowAmbiguousTypes, LambdaCase #-} -{- Exports the `inputWithTypeArgs` function, which is able to read dhall files of the normalized form - -@ -\(CustomType: Type) -> -\(AnotherType: Type) -> -… -@ - -and set their actual representation on the Haskell side: - -This has various advantages: - -- dhall files still type check & normalize with the normal dhall - tooling, they are standalone (and the types can be instantiated from - dhall as well without any workarounds) -- It can be used like the default `input` function, no injection of - custom symbols in the Normalizer is reqired -- Brings this style of dhall integration to Haskell, where it was only - feasible in nix before, because that is untyped - -The dhall types can be instantiated by every Haskell type that has an -`Interpret` instance. The “name” of the type lambda variable is -compared on the Haskell side with a type-level string that the user -provides, to prevent mixups. - -TODO: -- Improve error messages (!) -- Provide a way to re-use the type mapping on the Haskell side, so - that the returned values are not just the normal `Interpret` types, - but the mapped ones (with name phantom type) --} -module DhallTypedInput -( inputWithTypeArgs, TypeArg(..), TypeArgError(..), TypeArgEx(..), typeArg -) -where - -import Control.Monad.Trans.State.Strict as State -import Data.List (foldl') -import Control.Exception (Exception) -import qualified Control.Exception -import qualified Data.Text as Text - -import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) -import Data.Proxy (Proxy(Proxy)) - -import Dhall (Type(..), InvalidType(..), InputSettings(..), EvaluateSettings(..), rootDirectory, startingContext, normalizer, standardVersion, sourceName, defaultEvaluateSettings, Interpret(..), auto) -import Dhall.TypeCheck (X) -import Dhall.Core -import Dhall.Parser (Src(..)) -import qualified Dhall.Import -import qualified Dhall.Pretty -import qualified Dhall.TypeCheck -import qualified Dhall.Parser - -import Lens.Family (LensLike', set, view) - -import Data.Text.Prettyprint.Doc (Pretty) -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty - - --- | Information about a type argument in the dhall input --- --- If the dhall file starts with @\(CustomType : Type) ->@, --- that translates to @TypeArg "CustomType" interpretionType@ --- where @"CustomType"@ is a type-level string describing the --- name of the type in the dhall file (as a sanity check) and --- @interpretationType@ is any type which implements --- 'Dhall.Interpret'. --- --- This is basically a specialized 'Data.Proxy'. -data TypeArg (sym :: Symbol) t = TypeArg - --- | Existential wrapper of a 'TypeArg', allows to create a list --- of heterogenous 'TypeArg's. -data TypeArgEx - where TypeArgEx :: (KnownSymbol sym, Interpret t) => TypeArg sym t -> TypeArgEx - --- | Shortcut for creating a 'TypeArgEx'. --- --- Use with @TypeApplications@: --- --- @ --- typeArg @"CustomType" @Integer --- @ -typeArg :: forall sym t. (KnownSymbol sym, Interpret t) => TypeArgEx -typeArg = TypeArgEx (TypeArg :: TypeArg sym t) - --- | Possible errors returned when applying a 'TypeArg' --- to a 'Dhall.Expr'. -data TypeArgError - = WrongLabel Text.Text - -- ^ The name (label) of the type was different, - -- the text value is the expected label. - | NoLambda - -- ^ The 'Dhall.Expr' does not start with 'Dhall.Lam'. - --- | Apply a 'TypeArg' to a 'Dhall.Expr'. --- --- Checks that the dhall file starts with the 'Dhall.Lam' --- corresponding to 'TypeArg`, then applies @t@ (dhall type application) --- and normalizes, effectively stripping the 'Dhall.Lam'. -applyTypeArg - :: forall sym t. (KnownSymbol sym, Interpret t) - => Expr Src X - -> TypeArg sym t - -> Either TypeArgError (Expr Src X) -applyTypeArg expr ta@(TypeArg) = case expr of - (Lam label (Const Dhall.Core.Type) _) - -> let expectedLabel = getLabel ta - in if label /= getLabel ta - then Left (WrongLabel expectedLabel) - else let expr' = (normalize (App expr tExpect)) - in Right expr' - where - Dhall.Type _ tExpect = Dhall.auto :: Dhall.Type t - expr -> Left NoLambda - --- | Inflect the type-level string @sym@ to a text value. -getLabel :: forall sym t. (KnownSymbol sym) => TypeArg sym t -> Text.Text -getLabel _ = Text.pack $ symbolVal (Proxy :: (Proxy :: Symbol -> *) sym) - -instance (KnownSymbol sym) => Show (TypeArg sym t) where - show TypeArg = - "TypeArg " - ++ (symbolVal (Proxy :: (Proxy :: Symbol -> *) sym)) - --- | Takes a list of 'TypeArg's and parses the given --- dhall string, applying the given 'TypeArg's in order --- to the opaque dhall type arguments (see 'TypeArg' for --- how these should look). --- --- This is a slightly changed 'Dhall.inputWith'. --- --- Discussion: Any trace of our custom type is removed from --- the resulting -inputWithTypeArgs - :: InputSettings - -> [TypeArgEx] - -> Dhall.Type a - -> Text.Text - -> IO a -inputWithTypeArgs settings typeArgs (Dhall.Type {extract, expected}) txt = do - expr <- throws (Dhall.Parser.exprFromText (view sourceName settings) txt) - - -- TODO: evaluateSettings not exposed - -- let evSettings = view evaluateSettings settings - let evSettings :: EvaluateSettings = defaultEvaluateSettings - - -- -vvv copied verbatim from 'Dhall.inputWith' vvv- - let transform = - set Dhall.Import.standardVersion - (view standardVersion evSettings) - . set Dhall.Import.normalizer - (view normalizer evSettings) - . set Dhall.Import.startingContext - (view startingContext evSettings) - - let status = transform (Dhall.Import.emptyStatus - (view rootDirectory settings)) - - expr' <- State.evalStateT (Dhall.Import.loadWith expr) status - -- -^^^ copied verbatim ^^^- - - let - -- | if there’s a note, run the transformation and rewrap with the note - skipNote e f = case e of - Note n e -> Note n $ f e - e -> f e - - let - -- | strip one 'TypeArg' - stripTypeArg :: Expr Src X -> TypeArgEx -> Expr Src X - stripTypeArg e (TypeArgEx ta) = skipNote e $ \e' -> case e' of - (Lam label _ _) -> - case applyTypeArg e' ta of - Right e'' -> e'' - -- TODO obvously improve error messages - Left (WrongLabel l) -> - error $ "Wrong label, should have been `" ++ Text.unpack l ++ "` but was `" ++ Text.unpack label ++ "`" - Left NoLambda -> error $ "I expected a lambda of the form λ(" ++ Text.unpack label ++ ": Type) → but got: " ++ show e - e' -> error $ show e' - - -- strip all 'TypeArg's - let expr'' = foldl' stripTypeArg expr' typeArgs - - -- -vvv copied verbatim as well (expr' -> expr'') vvv- - let suffix = prettyToStrictText expected - let annot = case expr'' of - Note (Src begin end bytes) _ -> - Note (Src begin end bytes') (Annot expr'' expected) - where - bytes' = bytes <> " : " <> suffix - _ -> - Annot expr'' expected - - _ <- throws (Dhall.TypeCheck.typeWith (view startingContext settings) annot) - case extract (Dhall.Core.normalizeWith (Dhall.Core.getReifiedNormalizer (view normalizer settings)) expr'') of - Just x -> return x - Nothing -> Control.Exception.throwIO InvalidType - - --- copied from Dhall.Pretty.Internal -prettyToStrictText :: Pretty a => a -> Text.Text -prettyToStrictText = docToStrictText . Pretty.pretty - --- copied from Dhall.Pretty.Internal -docToStrictText :: Pretty.Doc ann -> Text.Text -docToStrictText = Pretty.renderStrict . Pretty.layoutPretty options - where - options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded } - --- copied from somewhere in Dhall -throws :: Exception e => Either e a -> IO a -throws (Left e) = Control.Exception.throwIO e -throws (Right r) = return r - - --- TODO: add errors like these --- data WrongTypeLabel = WrongTypeLabel deriving (Typeable) - --- _ERROR :: String --- _ERROR = "\ESC[1;31mError\ESC[0m" - --- instance Show WrongTypeLabel where --- show WrongTypeLabel = --- _ERROR <> ": Mislabelled type lambda --- \ \n\ --- \Expected your t provide an extract function that succeeds if an expression \n\ --- \matches the expected type. You provided a Type that disobeys this contract \n" |