about summary refs log tree commit diff
path: root/pkgs/profpatsch/dhallsh
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2019-09-16 00:56:37 +0200
committerProfpatsch <mail@profpatsch.de>2020-02-24 00:57:55 +0100
commit7bb981bca6c1fabb7bdfe367a6b19042ca36afd7 (patch)
treec874fd97aeab7e47d6ec66e0fbcc7d1db78f9794 /pkgs/profpatsch/dhallsh
parent0170d75092b4750ad03d9c606918cf659703e8d5 (diff)
Mostly implement nice completion for dhall
A few bugs are still remainaing, but it can recognize when files
should be completed for example.
Diffstat (limited to 'pkgs/profpatsch/dhallsh')
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/Command/Arguments.dhall1
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/Command/package.dhall1
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/Command/type.dhall4
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/Option/type.dhall10
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/completion.dhall168
-rw-r--r--pkgs/profpatsch/dhallsh/Completion/package.dhall1
-rw-r--r--pkgs/profpatsch/dhallsh/Fish/Complete/toCommand.dhall2
-rw-r--r--pkgs/profpatsch/dhallsh/imports/Void.dhall1
-rw-r--r--pkgs/profpatsch/dhallsh/main.dhall173
9 files changed, 235 insertions, 126 deletions
diff --git a/pkgs/profpatsch/dhallsh/Completion/Command/Arguments.dhall b/pkgs/profpatsch/dhallsh/Completion/Command/Arguments.dhall
new file mode 100644
index 00000000..e9ec3663
--- /dev/null
+++ b/pkgs/profpatsch/dhallsh/Completion/Command/Arguments.dhall
@@ -0,0 +1 @@
+λ(a : Type) → < Subcommands : List a | Files >
diff --git a/pkgs/profpatsch/dhallsh/Completion/Command/package.dhall b/pkgs/profpatsch/dhallsh/Completion/Command/package.dhall
new file mode 100644
index 00000000..6475acf9
--- /dev/null
+++ b/pkgs/profpatsch/dhallsh/Completion/Command/package.dhall
@@ -0,0 +1 @@
+{ Type = ./type.dhall, Arguments = ./Arguments.dhall }
diff --git a/pkgs/profpatsch/dhallsh/Completion/Command/type.dhall b/pkgs/profpatsch/dhallsh/Completion/Command/type.dhall
index a0fd4e98..ffbcd2bf 100644
--- a/pkgs/profpatsch/dhallsh/Completion/Command/type.dhall
+++ b/pkgs/profpatsch/dhallsh/Completion/Command/type.dhall
@@ -5,6 +5,6 @@
       Text
   , options :
       List ../Option/type.dhall
-  , subcommands :
-      List a
+  , arguments :
+      ./Arguments.dhall a
   }
diff --git a/pkgs/profpatsch/dhallsh/Completion/Option/type.dhall b/pkgs/profpatsch/dhallsh/Completion/Option/type.dhall
index 44f62d2e..9f5d14f1 100644
--- a/pkgs/profpatsch/dhallsh/Completion/Option/type.dhall
+++ b/pkgs/profpatsch/dhallsh/Completion/Option/type.dhall
@@ -1,9 +1 @@
-{ short :
-    Optional Text
-, long :
-    Text
-, description :
-    Text
-, argument :
-    Optional Text
-}
+{ short : Optional Text, long : Text, description : Text, takes-files : Bool }
diff --git a/pkgs/profpatsch/dhallsh/Completion/completion.dhall b/pkgs/profpatsch/dhallsh/Completion/completion.dhall
index e5b849a7..4b5bdad0 100644
--- a/pkgs/profpatsch/dhallsh/Completion/completion.dhall
+++ b/pkgs/profpatsch/dhallsh/Completion/completion.dhall
@@ -2,30 +2,30 @@ let Void = ../imports/Void.dhall
 
 let Option = ./Option/type.dhall
 
-let Command = ./Command/type.dhall
+let Command = ./Command/package.dhall
 
 let opt =
         λ(long : Text)
       → λ(description : Text)
       → { long =
             long
-        , description =
-            description
-        , argument =
-            None Text
         , short =
             None Text
+        , description =
+            description
+        , takes-files =
+            False
         }
 
 let fileOpt =
         opt "file" "Read expression from a file instead of standard input"
-      ⫽ { argument = Some "FILE" }
+      ⫽ { takes-files = True }
 
 let alphaOpt = opt "alpha" "α-normalize expression"
 
 let inplaceOpt =
         opt "inplace" "Modify the specified file in-place"
-      ⫽ { argument = Some "FILE" }
+      ⫽ { takes-files = True }
 
 let jsonOpt = opt "json" "Use JSON representation of CBOR"
 
@@ -34,81 +34,93 @@ let leafCommand =
       → λ(description : Text)
       → { options =
             [] : List Option
-        , subcommands =
-            [] : List Void
+        , arguments =
+            (Command.Arguments Void).Subcommands ([] : List Void)
         , name =
             name
         , description =
             description
         }
 
-in    { name =
-          "dhall"
-      , description =
-          "Interpreter for the Dhall language"
-      , options =
-          [ opt "annotate" "Add a type annotation to the output"
-          , alphaOpt
-          , opt "explain" "Explain error messages in more detail"
-          , opt "plain" "Disable syntax highlighting"
-          , opt "ascii" "Format code using only ASCII syntax"
-          ,   opt "standard-version" "The standard version to use"
-            ⫽ { argument = Some "X.Y.Z" }
-          ]
-      , subcommands =
-          [ leafCommand
-            "version"
-            "Display version"
-          ,   leafCommand "resolve" "Resolve an expression's imports"
-            ⫽ { options =
-                  [ fileOpt
-                  , opt "dot" "Output import dependency graph in dot format"
-                  , opt
-                    "immediate-dependencies"
-                    "List immediate import dependencies"
-                  , opt
-                    "transitive-dependencies"
-                    "List transitive import dependencies"
-                  ]
-              }
-          ,   leafCommand "type" "Infer an expression's type"
-            ⫽ { options = [ fileOpt ] }
-          ,   leafCommand "normalize" "Normalize an expression"
-            ⫽ { options = [ fileOpt, alphaOpt ] }
-          , leafCommand "repl" "Interpret expressions in a REPL"
-          , leafCommand
-            "diff"
-            "Render the difference between the normal form of two expressions"
-          , leafCommand "hash" "Compute semantic hashes for Dhall expressions"
-          ,   leafCommand "lint" "Improve Dhall code"
-            ⫽ { options = [ inplaceOpt ] }
-          ,   leafCommand "format" "Formatter for the Dhall language"
-            ⫽ { options =
-                  [ opt "check" "Only check if the input is formatted"
-                  , inplaceOpt
-                  ]
-              }
-          ,   leafCommand
-              "freeze"
-              "Add integrity checks to remote import statements of an expression"
-            ⫽ { options =
-                  [ inplaceOpt
-                  , opt
-                    "all"
-                    "Add integrity checks to all imports (not just remote imports)"
-                  , opt
-                    "cache"
-                    "Add fallback unprotected imports when using integrity checks purely for caching purposes"
-                  ]
-              }
-          ,   leafCommand "encode" "Encode a Dhall expression to binary"
-            ⫽ { options = [ fileOpt, jsonOpt ] }
-          ,   leafCommand "decode" "Decode a Dhall expression from binary"
-            ⫽ { options = [ fileOpt, jsonOpt ] }
-          ,   leafCommand
-              "text"
-              "Render a Dhall expression that evaluates to a Text literal"
-            ⫽ { options = [ fileOpt ] }
-          ]
+in    { toplevelCommandIsSubcommand =
+          True
+      , command =
+          { name =
+              "dhall"
+          , description =
+              "Interpreter for the Dhall language"
+          , options =
+              [ fileOpt
+              , opt "annotate" "Add a type annotation to the output"
+              , alphaOpt
+              , opt "explain" "Explain error messages in more detail"
+              , opt "plain" "Disable syntax highlighting"
+              , opt "ascii" "Format code using only ASCII syntax"
+              , opt "standard-version" "The standard version to use"
+              ]
+          , arguments =
+              ( Command.Arguments
+                (Command.Type Void)
+              ).Subcommands
+              [ leafCommand "version" "Display version"
+              ,   leafCommand "resolve" "Resolve an expression's imports"
+                ⫽ { options =
+                      [ fileOpt
+                      , opt "dot" "Output import dependency graph in dot format"
+                      , opt
+                        "immediate-dependencies"
+                        "List immediate import dependencies"
+                      , opt
+                        "transitive-dependencies"
+                        "List transitive import dependencies"
+                      ]
+                  }
+              ,   leafCommand "type" "Infer an expression's type"
+                ⫽ { options = [ fileOpt ] }
+              ,   leafCommand "normalize" "Normalize an expression"
+                ⫽ { options = [ fileOpt, alphaOpt ] }
+              , leafCommand "repl" "Interpret expressions in a REPL"
+              ,   leafCommand
+                  "diff"
+                  "Render the difference between the normal form of two expressions"
+                ⫽ { arguments = (Command.Arguments Void).Files }
+              , leafCommand
+                "hash"
+                "Compute semantic hashes for Dhall expressions"
+              ,   leafCommand "lint" "Improve Dhall code"
+                ⫽ { options = [ inplaceOpt ] }
+              ,   leafCommand "format" "Formatter for the Dhall language"
+                ⫽ { options =
+                      [ opt "check" "Only check if the input is formatted"
+                      , inplaceOpt
+                      ]
+                  }
+              ,   leafCommand
+                  "freeze"
+                  "Add integrity checks to remote import statements of an expression"
+                ⫽ { options =
+                      [ inplaceOpt
+                      , opt
+                        "all"
+                        "Add integrity checks to all imports (not just remote imports)"
+                      , opt
+                        "cache"
+                        "Add fallback unprotected imports when using integrity checks purely for caching purposes"
+                      ]
+                  }
+              ,   leafCommand "encode" "Encode a Dhall expression to binary"
+                ⫽ { options = [ fileOpt, jsonOpt ] }
+              ,   leafCommand "decode" "Decode a Dhall expression from binary"
+                ⫽ { options = [ fileOpt, jsonOpt ] }
+              ,   leafCommand
+                  "text"
+                  "Render a Dhall expression that evaluates to a Text literal"
+                ⫽ { options = [ fileOpt ] }
+              ]
+          }
+      }
+    : { command :
+          Command.Type (Command.Type Void)
+      , toplevelCommandIsSubcommand :
+          Bool
       }
-    : Command (Command Void)
diff --git a/pkgs/profpatsch/dhallsh/Completion/package.dhall b/pkgs/profpatsch/dhallsh/Completion/package.dhall
new file mode 100644
index 00000000..01044c54
--- /dev/null
+++ b/pkgs/profpatsch/dhallsh/Completion/package.dhall
@@ -0,0 +1 @@
+{ Option = ./Option/type.dhall, Command = ./Command/package.dhall }
diff --git a/pkgs/profpatsch/dhallsh/Fish/Complete/toCommand.dhall b/pkgs/profpatsch/dhallsh/Fish/Complete/toCommand.dhall
index f7453b65..67327b5f 100644
--- a/pkgs/profpatsch/dhallsh/Fish/Complete/toCommand.dhall
+++ b/pkgs/profpatsch/dhallsh/Fish/Complete/toCommand.dhall
@@ -43,7 +43,6 @@ in    λ(conditionOptionPrinter : OptionPrinter)
 
       let args =
               [ long "command" (Some c.cmd)
-              , long "description" (Some c.description)
               , Prelude.Optional.map
                 (Command Argument)
                 Argument
@@ -60,6 +59,7 @@ in    λ(conditionOptionPrinter : OptionPrinter)
               , flag "keep-order" c.keep-order
               , flag "no-files" c.no-files
               , flag "require-parameter" c.require-parameter
+              , long "description" (Some c.description)
               ]
             : List (Optional Argument)
 
diff --git a/pkgs/profpatsch/dhallsh/imports/Void.dhall b/pkgs/profpatsch/dhallsh/imports/Void.dhall
new file mode 100644
index 00000000..55a3760e
--- /dev/null
+++ b/pkgs/profpatsch/dhallsh/imports/Void.dhall
@@ -0,0 +1 @@
+https://raw.githubusercontent.com/sellout/dada/master/Void/Type sha256:a413d5091ac5fb02410f02bdbede12eacd89ae52a933a6d24bb68eadbff92613
diff --git a/pkgs/profpatsch/dhallsh/main.dhall b/pkgs/profpatsch/dhallsh/main.dhall
index abf53032..f89f7ed1 100644
--- a/pkgs/profpatsch/dhallsh/main.dhall
+++ b/pkgs/profpatsch/dhallsh/main.dhall
@@ -1,8 +1,12 @@
+let Void = ./imports/Void.dhall
+
+let Prelude = ./imports/Prelude.dhall
+
 let Command = ./Command/type.dhall
 
 let Argument = ./Argument/type.dhall
 
-let Complete = ./Fish/Complete/type.dhall
+let FishComplete = ./Fish/Complete/type.dhall
 
 let argCommandToList
     : Command Argument → List Text
@@ -13,44 +17,141 @@ let argCommandToList
 let complete = ./Fish/Complete/default.dhall
 
 let completeToCommand
-    : Complete → Command Argument
+    : FishComplete → Command Argument
     = ./Fish/Complete/toCommand.dhall ./OptionPrinter/newStyle.dhall
 
+let Completion = ./Completion/package.dhall
+
+let InSubcommand = < No | ToplevelSpecial | Subcommand : Text >
+
 in  let fishSeenSubcommandFn = "__fish_seen_subcommand_from"
 
     let fishUseSubcommandFn = "__fish_use_subcommand"
 
-    let fooSubcommand
-        : Command Argument
-        = completeToCommand
-          (   complete { cmd = "abc", description = "this is foo option" }
-            ⫽ { condition =
-                  Some { cmd = fishUseSubcommandFn, args = [] : List Argument }
-              , argument =
-                  Some "foo"
-              }
-          )
-
-    let fooSubcommandBarOption
-        : Command Argument
-        = completeToCommand
-          (   complete { cmd = "abc", description = "will bar the baz" }
-            ⫽ { condition =
-                  Some
-                  { cmd =
-                      fishSeenSubcommandFn
-                  , args =
-                      [ Argument.Plain "foo" ]
-                  }
-              , long-option =
-                  Some "bar"
-              , short-option =
-                  Some "b"
-              }
-          )
-
-    in    [ argCommandToList fooSubcommand
-          , argCommandToList fooSubcommandBarOption
-          , [ "complete", "--do-complete=abc foo -" ]
-          ]
-        : List (List Text)
+    let fishCommandLineExactlyFn = "__fish_command_line_exactly"
+
+    let subcommandCond =
+            λ(programName : Text)
+          → λ(inSubcommand : InSubcommand)
+          → merge
+            { ToplevelSpecial =
+                Some
+                { cmd =
+                    fishCommandLineExactlyFn
+                , args =
+                    [ Argument.Plain programName ]
+                }
+            , Subcommand =
+                  λ(sub : Text)
+                → Some
+                  { cmd = fishSeenSubcommandFn, args = [ Argument.Plain sub ] }
+            , No =
+                None (Command Argument)
+            }
+            inSubcommand
+            : Optional (Command Argument)
+
+    let optionsComplete =
+            λ(programName : Text)
+          → λ(inSubcommand : InSubcommand)
+          → λ(options : List Completion.Option)
+          → let optcompl =
+                    λ(option : Completion.Option)
+                  →   complete
+                      { cmd = programName, description = option.description }
+                    ⫽ { condition =
+                          subcommandCond programName inSubcommand
+                      , short-option =
+                          option.short
+                      , long-option =
+                          Some option.long
+                      }
+
+            in  Prelude.List.map Completion.Option FishComplete optcompl options
+
+    let mergeCommandArguments =
+            λ(programName : Text)
+          → λ(inSubcommand : InSubcommand)
+          → λ(a : Type)
+          → λ(f : List a → List FishComplete)
+          → λ(arguments : Completion.Command.Arguments a)
+          → let filesBlock =
+                    complete { cmd = programName, description = "" }
+                  ⫽ { condition =
+                        subcommandCond programName inSubcommand
+                    , no-files =
+                        True
+                    }
+
+            in  merge
+                { Subcommands =
+                    λ(cmds : List a) → f cmds # [ filesBlock ]
+                , Files =
+                    [] : List FishComplete
+                }
+                arguments
+                : List FishComplete
+
+    let subcommandToFishComplete =
+            λ(programName : Text)
+          → λ(command : Completion.Command.Type Void)
+          → let subcommandComplete =
+                    [   complete
+                        { cmd = programName, description = command.description }
+                      ⫽ { condition =
+                            Some
+                            { cmd =
+                                fishUseSubcommandFn
+                            , args =
+                                [] : List Argument
+                            }
+                        , argument =
+                            Some command.name
+                        , no-files =
+                            False
+                        }
+                    ]
+                  # optionsComplete
+                    programName
+                    (InSubcommand.Subcommand command.name)
+                    command.options
+
+            in    subcommandComplete
+                # mergeCommandArguments
+                  programName
+                  (InSubcommand.Subcommand command.name)
+                  Void
+                  (λ(_ : List Void) → [] : List FishComplete)
+                  command.arguments
+
+    let simpleCommandToFishComplete =
+            λ ( c
+              : { command :
+                    Completion.Command.Type (Completion.Command.Type Void)
+                , toplevelCommandIsSubcommand :
+                    Bool
+                }
+              )
+          →   optionsComplete c.command.name InSubcommand.No c.command.options
+            # mergeCommandArguments
+              c.command.name
+              (       if c.toplevelCommandIsSubcommand
+
+                then  InSubcommand.ToplevelSpecial
+
+                else  InSubcommand.No
+              )
+              (Completion.Command.Type Void)
+              ( Prelude.List.concatMap
+                (Completion.Command.Type Void)
+                FishComplete
+                (subcommandToFishComplete c.command.name)
+              )
+              c.command.arguments
+
+    in    Prelude.List.map
+          FishComplete
+          (List Text)
+          (λ(c : FishComplete) → argCommandToList (completeToCommand c))
+          (simpleCommandToFishComplete ./Completion/completion.dhall)
+        # [ [ "complete", "--do-complete=dhall " ] ]