Add options to spec implicitly (fix #72)

WARN: this is a minor breaking change in that the spec serializes
slightly different now. Option-aliases are serialized into a more
friendly format, i.e. "-f" and "--foo" as opposed to the more simple,
yet more verbose `{ type: "long", name: "foo" }`.

src/Neodoc/ArgParser/Parser.purs

@@ -447,17 +447,17 @@ solve l repOpts sub req = skipIf hasTerminated Nil $ go l sub req Nil true Nil
         then dropFirst (\x -> _isOptionalGroup x && _isFixed x) ys'
         else ys' /\ false
 
-      trace l \i-> "match: eval"
+      trace l \i' -> "match: eval"
           <> " ys = " <> pretty ys
           <> ", ys' = " <> pretty ys'
           <> ", ys'' = " <> pretty ys''
           <> ", locked = " <> show locked
           <> ", sub = " <> show sub
-          <> ", i = " <> pretty i
+          <> ", i = " <> pretty i'
 
       case if sub then filter (not <<< _isOptionalGroup) ys'' else ys'' of
         Nil -> do
-          trace l \i-> "match: succeeded!, i = " <> pretty i
+          trace l \i' -> "match: succeeded!, i = " <> pretty i'
 
           -- substitute all leaf elements. we ignore groups because these groups
           -- have failed to parse irrespective of substitution, so they are a
@@ -478,7 +478,7 @@ solve l repOpts sub req = skipIf hasTerminated Nil $ go l sub req Nil true Nil
         zs | changed -> go' errs false zs Nil Nil
 
         z:zs -> do
-          trace l \i-> "match: failed!" <> pretty (z:zs) <> ", i = " <> pretty i
+          trace l \i' -> "match: failed!" <> pretty (z:zs) <> ", i = " <> pretty i'
           i <- getInput
           { depth } <- getState
           case errs of

src/Neodoc/Neodoc.purs

@@ -179,15 +179,18 @@ _run input (NeodocOptions opts) = do
            in Right result
     Error.capture do
       Solver.solve'
-        opts
+        { smartOptions: opts.smartOptions
+        , helpFlags: fromFoldable opts.helpFlags
+        , versionFlags: fromFoldable opts.versionFlags
+        }
         (fromFoldable $ either (fromJSCallback <$> _) id opts.transforms.presolve)
         (fromFoldable $ either (fromJSCallback <$> _) id opts.transforms.postsolve)
         inputSpec
 
   let
     runNeodocError' :: ∀ a. Either _ a -> Eff _ a
     runNeodocError' = runNeodocError  (Just program)
-                                      (Just opts.helpFlags)
+                                      (Just (pretty <$> opts.helpFlags))
                                       (Just shortHelp)
 
   -- 3. run the arg parser agains the spec and user input
@@ -197,13 +200,13 @@ _run input (NeodocOptions opts) = do
         ArgParser.run spec opts env argv
     pure $ Evaluate.reduce env descriptions mBranch vs
 
-  if output `has` opts.helpFlags then
+  if output `has` (pretty <$> opts.helpFlags) then
     let helpText' = trimHelp helpText
      in if opts.dontExit
           then pure (HelpOutput helpText')
           else Console.log helpText' *> Process.exit 0
     else
-      if output `has` opts.versionFlags then do
+      if output `has` (pretty <$> opts.versionFlags) then do
         mVer <- maybe readPkgVersion (pure <<< pure) opts.version
         case mVer of
           Just ver ->
@@ -268,7 +271,11 @@ _runPure input (NeodocOptions opts) mVer = do
   -- 2. solve the spec
   spec@(Spec { descriptions }) <- do
     Error.capture do
-      Solver.solve opts inputSpec
+      Solver.solve {
+        smartOptions: opts.smartOptions
+      , helpFlags: fromFoldable opts.helpFlags
+      , versionFlags: fromFoldable opts.versionFlags
+      } inputSpec
 
   -- 3. run the arg parser agains the spec and user input
   ArgParseResult mBranch vs <- do
@@ -277,10 +284,10 @@ _runPure input (NeodocOptions opts) mVer = do
 
   let output = Evaluate.reduce env descriptions mBranch vs
 
-  if output `has` opts.helpFlags
+  if output `has` (pretty <$> opts.helpFlags)
     then pure (HelpOutput (trimHelp helpText))
     else
-      if output `has` opts.versionFlags then do
+      if output `has` (pretty <$> opts.versionFlags) then do
         case mVer of
           Just ver -> pure (VersionOutput ver)
           Nothing ->  Left Error.VersionMissingError

src/Neodoc/OptionAlias.purs

@@ -9,7 +9,8 @@ module Neodoc.OptionAlias (
 
 import Prelude
 import Data.String as String
-import Data.List (List(), (:))
+import Data.Maybe (Maybe(..))
+import Data.List (List(Nil), (:))
 import Data.Either (Either(..))
 import Data.Function (on)
 import Data.Generic (class Generic, gEq, gShow)
@@ -36,16 +37,21 @@ instance showOptionAlias :: Show OptionAlias where
 
 instance isForeignOptionAlias :: IsForeign OptionAlias where
   read v = do
-    typ :: String <- String.toUpper <$> F.readProp "type" v
-
-    case typ of
-      "SHORT" -> Short <$> F.readProp "char" v
-      "LONG"  -> Long  <$> F.readProp "name" v
-      _ -> Left $ F.errorAt "type" (F.JSONError $ "unknown type: " <> typ)
+    s :: String <- read v
+    case String.uncons s of
+      Just { head: '-', tail } ->
+        case String.uncons tail of
+          Just { head: '-', tail: "" } ->
+            Left $ F.JSONError "long option must have a name"
+          Just { head: '-', tail: tail' } -> pure $ Long tail'
+          Just { head, tail: "" } -> pure $ Short head
+          _ -> Left $ F.JSONError "short option must have a singe char"
+      Nothing -> Left $ F.JSONError "option may not be empty"
+      _ -> Left $ F.JSONError "option must start with a dash"
 
 instance asForeignOptionAlias :: AsForeign OptionAlias where
-  write (Short c) = F.toForeign { type: "Short", char: c }
-  write (Long  n) = F.toForeign { type: "Long", name: n }
+  write (Short c) = F.toForeign $ "-"  <> (String.singleton c)
+  write (Long  n) = F.toForeign $ "--" <> n
 
 instance prettyOptionAlias :: Pretty OptionAlias where
   pretty (Short c) = "-"  <> (String.singleton c)

src/Neodoc/Options.purs

@@ -1,27 +1,30 @@
 module Neodoc.Options where
 
 import Prelude
-import Data.Maybe (Maybe(..), maybe, fromMaybe)
-import Data.Either (Either(..), fromRight)
-import Data.Foreign (F, Foreign)
-import Data.Foreign as F
-import Data.Foreign.Class as F
-import Data.Foreign.Index as F
-import Data.Foreign.Index ((!))
 import Data.Foreign.Class
-import Data.Foreign.Extra as F
-import Control.Monad.Eff.Exception (Error, throwException, error, EXCEPTION)
+import Data.List (List)
 import Control.Monad.Eff
 import Neodoc.Spec
 import Neodoc.Data.EmptyableLayout
 import Neodoc.Data.UsageLayout
 import Neodoc.Data.SolvedLayout
+import Neodoc.OptionAlias as OA
 import Neodoc.Solve.Error
-import Neodoc.Solve (SolveOptions)
+import Unsafe.Coerce
+import Data.Foreign as F
+import Data.Foreign.Class as F
+import Data.Foreign.Extra as F
+import Data.Foreign.Index as F
 import Neodoc.ArgParser.Options as ArgParser
-import Neodoc.Env (Env(), unwrapEnv)
+import Control.Monad.Eff.Exception (Error, throwException, error, EXCEPTION)
+import Data.Either (Either(..), fromRight)
+import Data.Foreign (F, Foreign)
+import Data.Foreign.Index ((!))
+import Data.Maybe (Maybe(..), maybe, fromMaybe)
+import Neodoc.Env (Env, unwrapEnv)
+import Neodoc.OptionAlias (OptionAlias)
+import Neodoc.Solve (SolveOptions)
 import Neodoc.SpecConversions (fromEmptyableSpec, toEmptyableSpec)
-import Unsafe.Coerce
 
 foreign import data JSCALLBACK :: !
 
@@ -38,8 +41,8 @@ newtype NeodocOptions = NeodocOptions {
 , requireFlags :: Boolean      -- ^ do not ignore missing flags
 , laxPlacement :: Boolean      -- ^ allow positionals/commands to be appear anywhere
 , version      :: Maybe String -- ^ the version string to display
-, versionFlags :: Array String -- ^ list of flags that trigger 'version'
-, helpFlags    :: Array String -- ^ list of flags that trigger 'help'
+, versionFlags :: Array OptionAlias -- ^ list of flags that trigger 'version'
+, helpFlags    :: Array OptionAlias -- ^ list of flags that trigger 'help'
 , repeatableOptions :: Boolean -- ^ options are always allowed to repeat
 , transforms   :: {
     presolve :: ∀ eff. Either
@@ -64,8 +67,8 @@ _defaults = {
 , requireFlags: false
 , laxPlacement: false
 , version:      Nothing
-, versionFlags: [ "--version" ]
-, helpFlags:    [ "--help"    ]
+, versionFlags: [ OA.Long "version" ]
+, helpFlags:    [ OA.Long "help"    ]
 , transforms:   { presolve: Right [], postsolve: Right [] }
 , repeatableOptions: false
 }

src/Neodoc/Solve.purs

@@ -2,23 +2,27 @@ module Neodoc.Solve where
 
 import Prelude
 import Debug.Trace
-import Data.Either (Either(..), either)
-import Data.List (List(..))
-import Data.List as List
-import Data.Foldable (class Foldable)
-import Data.Traversable (for)
 import Neodoc.Spec
-import Neodoc.Spec as Spec
 import Neodoc.Data.UsageLayout
 import Neodoc.Data.SolvedLayout
 import Neodoc.Solve.Error
-import Neodoc.Solve.SmartOptions as Solve
+import Data.List as List
+import Neodoc.Solve.Canonicalise as Solve
 import Neodoc.Solve.ExpandOptions as Solve
 import Neodoc.Solve.ExpandReferences as Solve
-import Neodoc.Solve.Canonicalise as Solve
+import Neodoc.Solve.ImplicitFlags as Solve
+import Neodoc.Solve.SmartOptions as Solve
+import Neodoc.Spec as Spec
+import Data.Either (Either(..), either)
+import Data.Foldable (class Foldable)
+import Data.List (List(..))
+import Data.Traversable (for)
+import Neodoc.OptionAlias (OptionAlias)
 
 type SolveOptions r = {
   smartOptions :: Boolean
+, versionFlags :: List OptionAlias
+, helpFlags :: List OptionAlias
   | r
 }
 
@@ -29,12 +33,13 @@ solve'
   -> List (Spec SolvedLayout -> Either SolveError (Spec SolvedLayout))
   -> Spec UsageLayout
   -> Either SolveError (Spec SolvedLayout)
-solve' { smartOptions } usageTs solvedTs =
+solve' { smartOptions, helpFlags, versionFlags } usageTs solvedTs =
       (if smartOptions then Solve.smartOptions else pure)
   >=> flip (List.foldM (#)) usageTs
   >=> Solve.expandOptions
   >=> Solve.expandReferences
   >=> Solve.canonicalise
+  >=> Solve.implicitFlags (helpFlags <> versionFlags)
   >=> flip (List.foldM (#)) solvedTs
 
 solve

src/Neodoc/Solve/ImplictFlags.purs

@@ -0,0 +1,38 @@
+{-
+Insert implicit flags into the specification.
+This ensures that e.g. `prog -v` or `prog -h` are always valid applications of
+the program.
+
+To do so, we quite simply add an extra usage top-level branch to the
+specification: `[-h] [-v]`.
+-}
+
+module Neodoc.Solve.ImplicitFlags where
+
+import Prelude
+import Data.NonEmpty
+import Neodoc.Spec
+import Neodoc.Data.Layout
+import Neodoc.Data.SolvedLayout
+import Neodoc.Solve.Error
+import Data.Array as A
+import Data.String as String
+import Data.Either (Either)
+import Data.List ((:), List(Nil), fromFoldable, catMaybes)
+import Data.Maybe (Maybe(..))
+import Data.Traversable (for, traverse)
+import Neodoc.OptionAlias (OptionAlias)
+import Neodoc.OptionAlias as OptionAlias
+
+implicitFlags
+  :: List OptionAlias
+  -> Spec SolvedLayout
+  -> Either SolveError (Spec SolvedLayout)
+implicitFlags flags (Spec (spec@{ layouts: x:|xs })) = pure $
+  let y = toOption <$> fromFoldable flags
+    in case y of
+      Nil  -> Spec spec { layouts = x :| xs }
+      z:zs -> Spec spec { layouts = (pure $ z :| zs) :| x : xs }
+  where
+  toOption a = Group true true (((Elem $ Option a Nothing true):|Nil):|Nil)
+

test-js/test.js

@@ -56,6 +56,70 @@ describe('neodoc', () => {
   });
 
   describe('special arguments', () => {
+    describe('option.helpFlags', () => {
+      it('should return the help', () => {
+        const help = 'usage: p [--help]';
+        const out = neodoc.run(help, { dontExit: true, argv: [ '--help' ]});
+        expect(out).to.equal(help);
+      });
+
+      it('should return the help (implicit)', () => {
+        const help = 'usage: p';
+        const out = neodoc.run(help, { dontExit: true, argv: [ '--help' ]});
+        expect(out).to.equal(help);
+      });
+
+      it('should return the help (implicit w/ alias)', () => {
+        const help = `\
+          usage: p
+          options:
+            -h, --help`;
+        const out = neodoc.run(help, { dontExit: true, argv: [ '-h' ]});
+        expect(out).to.equal(help);
+      });
+
+      it('should accept custom helpFlags (implicit)', () => {
+        const help = 'usage: p'
+        const out = neodoc.run(help, { dontExit: true, argv: [ '-h' ], helpFlags: [ '-h' ]});
+        expect(out).to.equal(help);
+      });
+    });
+
+    describe('option.versionFlags', () => {
+      it('should return the version', () => {
+        const version = '1.0.0';
+        const help = 'usage: p [--version]';
+        const out = neodoc.run(help, { dontExit: true, argv: [ '--version' ], version });
+        expect(out).to.equal(version);
+      });
+
+      it('should return the version (implicit)', () => {
+        const version = '1.0.0';
+        const help = 'usage: p';
+        const out = neodoc.run(help, { dontExit: true, argv: [ '--version' ], version});
+        expect(out).to.equal(version);
+      });
+
+      it('should return the version (implicit w/ alias)', () => {
+        const version = '1.0.0';
+        const help = `\
+          usage: p
+          options:
+            -v, --version`;
+        const out = neodoc.run(help, { dontExit: true, argv: [ '-v' ], version});
+        expect(out).to.equal(version);
+      });
+
+      it('should accept custom versionFlags (implicit)', () => {
+        const version = '1.0.0';
+        const help = 'usage: p'
+        const out = neodoc.run(help, { dontExit: true, argv: [ '-v' ], versionFlags: [ '-v' ], version});
+        expect(out).to.equal(version);
+      });
+    });
+  });
+
+  describe('special arguments (via cli)', () => {
     describe('option.helpFlags', () => {
       it('should print help', () => {
         for (let flag of ['-h', '--help', '-?']) {

test/Test/Spec/ArgParserSpec.purs

@@ -998,7 +998,10 @@ argParserSpec = \_ -> describe "The parser generator" do
 
               Error.capture do
                 Solver.solve
-                  { smartOptions: false }
+                  { smartOptions: false
+                  , versionFlags: Nil
+                  , helpFlags: Nil
+                  }
                   (Spec { program
                         , layouts
                         , descriptions

test/Test/Spec/SolveSpec.purs

@@ -242,6 +242,8 @@ solveSpec = \_ ->
         let description' = if S.length description > 0
                               then description
                               else "(no description)"
+            helpFlags = Nil -- XXX: {sh,c}ould be tested
+            versionFlags = Nil -- XXX: {sh,c}ould be tested
          in describe description' $
           let message = case expected of
                 Left err     -> "should fail with: " <> show err
@@ -277,7 +279,7 @@ solveSpec = \_ ->
                       , helpText: ""
                       , shortHelp: ""
                     })
-                  lmap pretty $ solve { smartOptions } spec
+                  lmap pretty $ solve { smartOptions, helpFlags, versionFlags } spec
             case expected' /\ output' of
               Left expected /\ Left actual | expected /= actual  ->
                 throwException $ error $