Merge branch 'refactor/parser' into development

Author: felixSchl

.vscode/settings.json

@@ -0,0 +1,5 @@
+{
+    "purescript.addNpmPath": true,
+    "editor.tabSize": 2,
+    "editor.rulers": [80,120]
+}

README.md

@@ -150,6 +150,10 @@ Options:
   `opts.versionFlags` is non-empty and `opts.version` is not set.
 * `opts.helpFlags` - An array of flags that trigger the special help
   behavior: Print the full program help text and exit with code 0.
+* `opts.repeatableOptions` - Allow options to be repeated even if the spec does
+  not explicitly allow this. This "loosens" up the parser to accept more input
+  and makes for a more intuitive command line. _Please note:_ repeatability
+  is still subject to chunking (use `opts.laxPlacement` to relax this further).
 * `opts.transforms.presolve` - an array of functions to be called prior to
   "solving" the input. This function takes the spec as it's only parameter.
   At this point, the spec is mostly untouched by neodoc with the exception of

package.json

@@ -15,7 +15,9 @@
     "test:js": "mocha --compilers js:babel-register test-js",
     "test:purs": "pulp test",
     "test": "npm run -s test:purs && npm run -s test:js",
-    "watch": "pulp -w --then 'npm run -s build && npm run -s test:js' test",
+    "watch": "npm run -s watch:purs",
+    "watch:all": "pulp -w test",
+    "watch:purs": "pulp -w test",
     "watch:js": "mocha -w --compilers js:babel-register test-js",
     "minify": "uglifyjs dist/neodoc.purs.js > dist/neodoc.purs.min.js",
     "deps": "bower install",

src/Data/Foldable/Extra.purs

@@ -0,0 +1,12 @@
+module Data.Foldable.Extra where
+
+import Prelude
+import Data.Maybe
+import Data.Foldable
+
+-- | Try to find an element in a data structure which satisfies a predicate mapping.
+findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b
+findMap p = foldl go Nothing
+  where
+  go Nothing x = p x
+  go r _ = r

src/Data/NonEmpty/Extra.purs

@@ -33,3 +33,10 @@ fromList
   -> Maybe (NonEmpty List a)
 fromList (x:xs) = Just (x :| xs)
 fromList Nil = Nothing
+
+fromList'
+  :: ∀ a
+   . Partial
+  => List a
+  -> NonEmpty List a
+fromList' (x:xs) = x :| xs

src/Data/Pretty/Pretty.purs

@@ -3,8 +3,9 @@ module Data.Pretty where
 import Prelude
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
-import Data.List (List)
+import Data.List (List, fromFoldable)
 import Data.Map (Map)
+import Data.Set (Set)
 import Data.Map as Map
 import Data.Either
 import Data.StrMap (StrMap)
@@ -33,6 +34,9 @@ instance prettyStrMap :: (Pretty v) => Pretty (StrMap v) where
   pretty kvs = intercalate ", " $ StrMap.toList kvs <#> \(k /\ v) ->
                   k <> " => " <> pretty v
 
+instance prettySet :: (Pretty k) => Pretty (Set k) where
+  pretty ks = pretty $ fromFoldable ks
+
 instance prettyEither :: (Pretty e, Pretty a) => Pretty (Either e a) where
   pretty (Left e) = pretty e
   pretty (Right a) = pretty a

src/Debug/Profile.js

@@ -11,6 +11,7 @@ exports.timerStart = function () {
 
 exports.timerEnd = function (start) {
   return function () {
-    return process.hrtime(start)[1]/1000000;
+    var hrTime = process.hrtime(start);
+    return hrTime[0] * 1000 + hrTime[1] / 1000000
   };
 }

src/Debug/Profile.purs

@@ -2,6 +2,8 @@ module Debug.Profile where
 
 import Prelude
 import Debug.Trace
+import Data.Either
+import Data.Tuple.Nested
 import Control.Monad.Eff
 import Control.Monad.Eff.Console
 import Control.Monad.Eff.Unsafe
@@ -24,6 +26,23 @@ profileA msg f =
       pure a
     else f unit
 
+profileS :: ∀ a. String -> (Unit -> a) -> a
+profileS msg f =
+  if _ENABLE_PROFILING_
+    then
+      let t' = unsafePerformEff timerStart
+          c = \_->
+                -- note: purescript appears to sort these assignments
+                -- alphabetically, which means, we must name our variables
+                -- accordingly. This depends on internal compiler behavior and
+                -- may break w/ an update of purescript.
+                let z = f unit
+                    t = unsafePerformEff $ timerEnd t'
+                 in z /\ t
+       in case c unit of
+            r /\ t -> trace (msg <> " (" <> (show t) <> " ms)") \_-> r
+    else f unit
+
 profileParser :: ∀ s m a. (Monad m) => String -> P.ParserT s m a -> P.ParserT s m a
 profileParser msg p = P.ParserT $ \s -> profileA msg \_ -> P.unParserT p s
 

src/Neodoc/ArgParser/Arg.purs

@@ -0,0 +1,89 @@
+module Neodoc.ArgParser.Arg where
+
+import Prelude
+import Data.Maybe
+import Data.Function (on)
+import Data.Generic
+import Data.Foldable (all)
+import Data.Pretty
+import Neodoc.Data.Layout
+import Neodoc.Value.RichValue
+import Neodoc.ArgKey
+import Neodoc.Data.SolvedLayout
+import Neodoc.Data.SolvedLayout as Solved
+
+{-
+  An argument data structure optimized for parsing.
+  The idea is to cache as much as possible up-front,
+  to avoid unnecessary traversals during the "hot"
+  phases of the parse (i.e. permutation parsing).
+ -}
+type Id = Int
+data Arg
+  = Arg Id                -- the unique id
+        SolvedLayoutArg   -- the wrapped arg
+        ArgKey            -- the (cached) arg key
+        (Maybe RichValue) -- the fallback value for this argument
+        Boolean           -- is this argument optional?
+type ArgLayout = Layout Arg
+
+derive instance genericArg :: Generic Arg
+
+instance showArg :: Show Arg where
+  show = gShow
+
+instance prettyArg :: Pretty Arg where
+  pretty (Arg i a _ _ o) =
+    "#" <> show i <> ":"
+        <> (if o then "[" else "")
+        <> pretty a
+        <> (if o then "]" else "")
+
+instance eqArg :: Eq Arg where
+  eq = eq `on` getId
+
+getArg :: Arg -> SolvedLayoutArg
+getArg (Arg _ x _ _ _) = x
+
+getArgKey :: Arg -> ArgKey
+getArgKey (Arg _ _ k _ _) = k
+
+getId :: Arg -> Id
+getId (Arg i _ _ _ _) = i
+
+setId :: Id -> Arg -> Arg
+setId i (Arg _ a k mV o) = Arg i a k mV o
+
+isOptional :: Arg -> Boolean
+isOptional (Arg _ _ _ _ o) = o
+
+getFallback :: Arg -> Maybe RichValue
+getFallback (Arg _ _ _ mV _) = mV
+
+setRepeatable :: Boolean -> ArgLayout -> ArgLayout
+setRepeatable b (Group o _ xs) = Group o b xs
+setRepeatable b (Elem x) = Elem $ setElemRepeatable b x
+
+setElemRepeatable :: Boolean -> Arg -> Arg
+setElemRepeatable b (Arg i x k mV o) = Arg i (Solved.setElemRepeatable b x) k mV o
+
+isFreeLayout :: ArgLayout -> Boolean
+isFreeLayout (Elem (Arg _ x _ _ _)) = Solved.isFreeElem x
+isFreeLayout (Group _ _ xs) = all (all isFreeLayout) xs
+
+isFree :: Arg -> Boolean
+isFree (Arg _ x _ _ _) = Solved.isFreeElem x
+
+isRepeatable :: ArgLayout ->  Boolean
+isRepeatable (Elem x) = isArgRepeatable x
+isRepeatable (Group _ r _) = r
+
+isArgRepeatable :: Arg -> Boolean
+isArgRepeatable (Arg _ x _ _ _) = Solved.isElemRepeatable x
+
+isOptionElem :: ArgLayout -> Boolean
+isOptionElem (Elem x) = isOption x
+isOptionElem _ = false
+
+isOption :: Arg -> Boolean
+isOption (Arg _ x _ _ _) = Solved.isOption x

src/Neodoc/ArgParser/Debug.purs

@@ -0,0 +1,63 @@
+module Neodoc.ArgParser.Debug where
+
+import Prelude
+import Debug.Trace hiding (trace)
+import Data.String as String
+import Data.Pretty
+import Data.List (List)
+import Data.List.Lazy as LL
+import Neodoc.ArgParser.Type
+import Neodoc.ArgParser.Token
+
+_ENABLE_DEBUG_ :: Boolean
+_ENABLE_DEBUG_ = false
+
+trace :: ∀ r. Int -> (List PositionedToken -> String) -> ArgParser r Unit
+trace l f = if _ENABLE_DEBUG_
+              then do
+                input       <- getInput
+                state       <- getState
+                globalState <- getGlobalState
+                traceA $ indent l <> stateLabel state globalState <> (f input)
+              else pure unit
+
+traceError :: ∀ r a. Int -> String -> ArgParser r a  -> ArgParser r a
+traceError l s = catch' \st e ->
+  trace l (\_ -> "! " <> s <> ": " <> pretty e)
+    *> setState st
+    *> throw e
+
+traceInput :: ∀ r. ArgParser r Unit
+traceInput = traceA =<< pretty <$> getInput
+
+indent :: Int -> String
+indent l = String.fromCharArray $ LL.toUnfoldable $ LL.take (l) $ LL.repeat ' '
+
+traceBracket
+  :: ∀ r a
+   . (Pretty a)
+  => Int
+  -> String
+  -> ArgParser r a
+  -> ArgParser r a
+traceBracket l label p = do
+  input       <- getInput
+  state       <- getState
+  globalState <- getGlobalState
+  trace l \_ ->
+    stateLabel state globalState <> " parsing " <> label <> " (input: " <> pretty input <> ")"
+  output <- traceError l (stateLabel state globalState <> " failed to parse " <> label) p
+  input'       <- getInput
+  state'       <- getState
+  globalState' <- getGlobalState
+  trace l \_ ->
+    stateLabel state' globalState' <> " successfully parsed " <> label <> "!"
+      <> " (output: " <> pretty output <> ")"
+      <> " (new input: " <> pretty input' <> ")"
+  pure output
+
+stateLabel :: ParseState -> GlobalParseState -> String
+stateLabel { hasTerminated, depth } { deepestError } =
+  (if hasTerminated then "✓" else "·")
+  -- <> "(" <> show depth <> ")"
+  -- <> "(dE = " <> show (pretty <$> deepestError) <> ")