pkgs/profpatsch/xdg-open: make possible to parse protocols

This is now on par with the original script in
https://github.com/Profpatsch/dotfiles/blob/a25c6c419525bef7ef5985f664b058dc9eb919e9/scripts/scripts/xdg-open

Eventually it should probably migrate away from a generated bash
script, but for now it’s fine.

2 files changed, 101 insertions, 60 deletions

diff --git a/pkgs/profpatsch/xdg-open/config.dhall b/pkgs/profpatsch/xdg-open/config.dhall
index 0550c94a..40a791af 100644
--- a/pkgs/profpatsch/xdg-open/config.dhall
+++ b/pkgs/profpatsch/xdg-open/config.dhall
@@ -35,8 +35,11 @@ let mime =
 
 let renderMime = λ(m : Mime) → 32
 
-let uriMimeGlobs =
-      [ { desc = "http link"
+let UriMimeGlob = { desc : Text, glob : List Text, mime : Mime }
+
+let uriMimeGlobs
+    : List UriMimeGlob
+    = [ { desc = "http link"
         , glob = [ "http://*", "https://*" ]
         , mime = mime.text.html
         }
@@ -63,21 +66,19 @@ let Special =
       }
 
 let mimeMatcher =
-        λ(pkgs : { package : Text, binary : Text } → Executable)
-      → λ(special : Special)
-      → let pkgSame =
-                λ(packageAndBinaryName : Text)
-              → pkgs
+      λ(pkgs : { package : Text, binary : Text } → Executable) →
+      λ(special : Special) →
+        let pkgSame =
+              λ(packageAndBinaryName : Text) →
+                pkgs
                   { package = packageAndBinaryName
                   , binary = packageAndBinaryName
                   }
 
         let oneArg =
-                λ(exe : Executable)
-              → { exe = exe, args = λ(file : Arg) → [ file ] }
+              λ(exe : Executable) → { exe, args = λ(file : Arg) → [ file ] }
 
-        let m =
-              λ(match : Mime) → λ(cmd : Command) → { match = match, cmd = cmd }
+        let m = λ(match : Mime) → λ(cmd : Command) → { match, cmd }
 
         in    [ { match = mime.mail-address, cmd = special.compose-mail-to }
               , { match = mime.text.html, cmd = special.open-in-browser }
@@ -91,8 +92,8 @@ let mimeMatcher =
                 , cmd =
                   { exe = pkgs { package = "gnupg", binary = "gpg" }
                   , args =
-                        λ(file : Arg)
-                      → [ Arg.String "--import"
+                      λ(file : Arg) →
+                        [ Arg.String "--import"
                         , Arg.String "--import-options"
                         , Arg.String "show-only"
                         , file
@@ -108,12 +109,13 @@ let mimeMatcher =
               ]
             : List MimeMatch
 
-in  { mimeMatcher = mimeMatcher
-    , uriMimeGlobs = uriMimeGlobs
-    , Executable = Executable
-    , Command = Command
-    , MimeMatch = MimeMatch
-    , Special = Special
-    , Mime = Mime
-    , Arg = Arg
+in  { mimeMatcher
+    , uriMimeGlobs
+    , UriMimeGlob
+    , Executable
+    , Command
+    , MimeMatch
+    , Special
+    , Mime
+    , Arg
     }
diff --git a/pkgs/profpatsch/xdg-open/xdg-open.dhall b/pkgs/profpatsch/xdg-open/xdg-open.dhall
index 8d6648b2..a7daebe3 100644
--- a/pkgs/profpatsch/xdg-open/xdg-open.dhall
+++ b/pkgs/profpatsch/xdg-open/xdg-open.dhall
@@ -21,17 +21,17 @@ let foo =
 let renderMime = Text/concatSep "/"
 
 let shellEscapeCommand =
-        λ(shellEscape : Text → Text)
-      → λ(file : Text)
-      → λ(cmd : config.Command)
-      →   Text/concatSep
+      λ(shellEscape : Text → Text) →
+      λ(file : Text) →
+      λ(cmd : config.Command) →
+          Text/concatSep
             " "
             (   [ shellEscape cmd.exe ]
               # List/map
                   config.Arg
                   Text
-                  (   λ(arg : config.Arg)
-                    → merge
+                  ( λ(arg : config.Arg) →
+                      merge
                         { String = λ(t : Text) → shellEscape t
                         , Variable = λ(t : Text) → t
                         }
@@ -42,52 +42,91 @@ let shellEscapeCommand =
         : Text
 
 let repeatText =
-        λ(t : Text)
-      → λ(n : Natural)
-      → Natural/fold n Text (λ(t2 : Text) → t ++ t2) ""
+      λ(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
+      λ(lines : Lines) →
+        Text/concatMap
           Text
           (λ(line : Text) → repeatText " " lines.indent ++ line ++ "\n")
           lines.lines
 
 let xdg-open =
-      let case =
-              λ(shellEscape2 : Text → Text)
-            → λ(file2 : Text)
-            → λ(m : config.MimeMatch)
-            → [ "${renderMime m.match})"
+      let mimeMatcherCase =
+            λ(shellEscape2 : Text → Text) →
+            λ(file2 : Text) →
+            λ(m : config.MimeMatch) →
+              [ "${renderMime m.match})"
               , "${shellEscapeCommand shellEscape2 file2 m.cmd}"
               , ";;"
               ]
 
-      in    λ(bins : { get-mime-type : Executable })
-          → λ(write-dash : Text → Text → Executable)
-          → λ(shellEscape : Text → Text)
-          → λ(pkgs : { package : Text, binary : Text } → Executable)
-          → λ(special : config.Special)
-          → write-dash
+      let mimeGlobCase =
+            λ(g : config.UriMimeGlob) →
+                List/concatMap
+                  Text
+                  Text
+                  ( λ(match : Text) →
+                      [ "${match})", "mime=${renderMime g.mime}", ";;" ]
+                  )
+                  g.glob
+              : List Text
+
+      in  λ(bins : { get-mime-type : Executable }) →
+          λ(write-dash : Text → Text → Executable) →
+          λ(shellEscape : Text → Text) →
+          λ(pkgs : { package : Text, binary : Text } → Executable) →
+          λ(special : config.Special) →
+            write-dash
               "xdg-open"
-              ''
-              set -e
-              file="$1"
-              mime=$(${bins.get-mime-type} "$file")
-
-              case "$mime" in
-              ${prettyLines
-                  { indent = 2
-                  , lines =
-                      List/concatMap
-                        config.MimeMatch
-                        Text
-                        (case shellEscape "\"\$file\"")
-                        (config.mimeMatcher pkgs special)
-                  }}
-              esac
-              ''
+              (     ''
+                    # TODO: --dry-run to display what would be opened and why
+
+                    # partially taken from
+                    # https://github.com/march-linux/mimi/blob/master/xdg-open
+
+                    set -e
+                    file="$1"
+                    case "$file" in
+                    ${prettyLines
+                        { indent = 2
+                        , lines =
+                            List/concatMap
+                              config.UriMimeGlob
+                              Text
+                              mimeGlobCase
+                              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
+                              config.MimeMatch
+                              Text
+                              (mimeMatcherCase shellEscape "\"\$file\"")
+                              (config.mimeMatcher pkgs special)
+                        }}
+                    esac
+                    ''
+              )
 
 in  xdg-open