diff --git a/bower.json b/bower.json index 5beca6c..a0990c0 100644 --- a/bower.json +++ b/bower.json @@ -25,10 +25,12 @@ "tests" ], "dependencies": { - "purescript-foreign": "^5.0.0", - "purescript-validation": "^4.0.0", - "purescript-record": "^2.0.0", - "purescript-node-process": "^7.0.0", - "purescript-console": "^4.1.0" + "purescript-foreign": "^6.0.1", + "purescript-validation": "^5.0.0", + "purescript-record": "^3.0.0", + "purescript-typelevel-prelude": "^6.0.0", + "purescript-node-process": "^8.2.0", + "purescript-console": "^5.0.0", + "purescript-numbers": "^8.0.0" } } diff --git a/src/Node/Commando.purs b/src/Node/Commando.purs index b8f70c8..eadcb56 100644 --- a/src/Node/Commando.purs +++ b/src/Node/Commando.purs @@ -11,18 +11,18 @@ import Data.List (List(Nil), (:)) import Data.Maybe (Maybe(..)) import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) import Node.Optlicative.Types (Optlicative) -import Record (delete, get) import Prim.Row as R import Prim.RowList as RL -import Type.Data.RowList (RLProxy(..)) +import Record (delete, get) +import Type.Proxy (Proxy(..)) class RLCommando - (rl :: RL.RowList) - (row :: # Type) + (rl :: RL.RowList Type) + (row :: Row Type) (a :: Type) | rl -> row where - rlCommando :: RLProxy rl -> Record row -> List String -> Maybe {cmd :: String, opt :: Optlicative a} + rlCommando :: Proxy rl -> Record row -> List String -> Maybe {cmd :: String, opt :: Optlicative a} instance basisRlHelp :: RLCommando RL.Nil () a where rlCommando _ _ _ = Nothing @@ -46,13 +46,13 @@ instance ihRlHelp :: in if cmd == reflectSymbol sproxy then Just {cmd, opt} - else rlCommando (RLProxy :: RLProxy tail) rectail args + else rlCommando (Proxy :: Proxy tail) rectail args rlCommando _ rec args@(x : xs) = -- haven't found final command yet let sproxy = SProxy :: SProxy k - rldeeper = RLProxy :: RLProxy list' - rlwider = RLProxy :: RLProxy tail + rldeeper = Proxy :: Proxy list' + rlwider = Proxy :: Proxy tail rec' = (getrow (get sproxy rec)) :: Record row' rectail = (delete sproxy rec) :: Record rowtail in @@ -62,16 +62,16 @@ instance ihRlHelp :: rlCommando _ _ _ = Nothing -- ran out of command path elements -class Commando (row :: # Type) a where +class Commando (row :: Row Type) a where commando :: Record row -> List String -> Maybe {cmd :: String, opt :: Optlicative a} instance rowHelpInst :: ( RL.RowToList row list , RLCommando list row a ) => Commando row a where - commando rec xs = rlCommando (RLProxy :: RLProxy list) rec xs + commando rec xs = rlCommando (Proxy :: Proxy list) rec xs -data Opt (a :: Type) (row :: # Type) = Opt (Optlicative a) (Record row) +data Opt (a :: Type) (row :: Row Type) = Opt (Optlicative a) (Record row) endOpt :: forall a. Optlicative a -> Opt a () endOpt o = Opt o {} diff --git a/src/Node/Optlicative.purs b/src/Node/Optlicative.purs index ad7a75a..6074316 100644 --- a/src/Node/Optlicative.purs +++ b/src/Node/Optlicative.purs @@ -21,18 +21,18 @@ module Node.Optlicative import Prelude import Control.Monad.Except (runExcept) -import Data.Array (intercalate) import Data.Either (Either(..)) import Data.Int (fromNumber) import Data.List (List(..), (:)) import Data.List as List import Data.Maybe (Maybe(..)) +import Data.Number (isNaN) +import Data.Number as Number import Data.Traversable (traverse) import Data.Validation.Semigroup (invalid, isValid, toEither) import Effect (Effect) import Effect.Console (error) import Foreign (F, Foreign, unsafeToForeign) -import Global (isNaN, readFloat) import Node.Commando (class Commando) import Node.Commando (class Commando, commando, Opt(..), endOpt) as Exports import Node.Optlicative.Internal (ddash, ex, except, find, hasHyphen, multipleErrorsToOptErrors, parse, removeAtFor, removeAtForWhile, removeHyphen, startsDash) @@ -53,7 +53,7 @@ flag :: String -> Maybe Char -> Optlicative Boolean flag name mc = Optlicative \ state -> case find ddash name state of Just i -> let - {removed, rest} = removeAtFor i 0 state + {rest} = removeAtFor i 0 state in {state: rest, val: pure true} _ -> case mc of @@ -86,7 +86,7 @@ int name msg = Optlicative \ state -> case find ddash name state of {removed, rest} = removeAtForWhile i 1 (not <<< startsDash) state in case List.head removed.unparsed of - Just h -> case fromNumber (readFloat h) of + Just h -> case fromNumber =<< Number.fromString h of Just n -> {state: rest, val: pure n} _ -> ex name "int" TypeError msg rest _ -> ex name (show 1) MissingArg msg rest @@ -102,9 +102,9 @@ float name msg = Optlicative \ state -> case find ddash name state of in case List.head removed.unparsed of Just h -> - if isNaN (readFloat h) - then ex name "float" TypeError msg rest - else {state: rest, val: pure (readFloat h)} + case Number.fromString h of + Just n | not isNaN n → {state: rest, val: pure n} + _ → ex name "float" TypeError msg rest _ -> ex name (show 1) MissingArg msg rest _ -> ex name mempty MissingOpt msg state @@ -126,7 +126,7 @@ many parser = Optlicative \optstate -> go parser optstate Nil go (Optlicative o) s acc = let { state, val } = o s - in + in case toEither val of Left _ -> { state, val: pure (List.reverse acc) } Right v -> go parser state (v:acc) @@ -185,7 +185,7 @@ manyF read len name msg = Optlicative \ state -> case find ddash name state of -- | A convenience function for nicely printing error messages. renderErrors :: List OptError -> String -renderErrors = intercalate "\n" <<< map renderOptError +renderErrors = List.intercalate "\n" <<< map renderOptError logErrors :: List OptError -> Effect Unit logErrors = error <<< renderErrors diff --git a/src/Node/Optlicative/Internal.purs b/src/Node/Optlicative/Internal.purs index fcde975..215b9a9 100644 --- a/src/Node/Optlicative/Internal.purs +++ b/src/Node/Optlicative/Internal.purs @@ -40,7 +40,7 @@ removeAtForWhile -> (String -> Boolean) -> OptState -> {removed :: OptState, rest :: OptState} -removeAtForWhile beg end f state@{unparsed} = +removeAtForWhile beg end f {unparsed} = let splice = spliceWhile f beg (end + 1) unparsed in @@ -177,27 +177,26 @@ parse -> {cmd :: Maybe String, value :: Value a} parse rec prefs argv = let - args = Array.drop 2 argv - argslist = List.fromFoldable args - {cmds, opts} = partitionArgsList argslist + argslist = List.fromFoldable (Array.drop 2 argv) + args = partitionArgsList argslist -- Commands - cmdores = commando rec cmds + cmdores = commando rec args.cmds cmd = _.cmd <$> cmdores -- Opts o = maybe prefs.globalOpts _.opt cmdores - {state, val} = unwrap o {unparsed: opts} - unrecCheck = prefs.errorOnUnrecognizedOpts && not (List.null state.unparsed) - value = case prefs.usage, unrecCheck, isValid val of + st = unwrap o {unparsed: args.opts} + unrecCheck = prefs.errorOnUnrecognizedOpts && not (List.null st.state.unparsed) + value = case prefs.usage, unrecCheck, isValid st.val of Just msg, true, true -> - unrecognizedOpts state <*> + unrecognizedOpts st.state <*> throwSingleError (Custom msg) Just msg, true, _ -> - unrecognizedOpts state <*> + unrecognizedOpts st.state <*> throwSingleError (Custom msg) <*> - val - Just msg, false, false -> throwSingleError (Custom msg) <*> val - Just _, false, _ -> val - _, true, _ -> unrecognizedOpts state <*> val - _, _, _ -> val + st.val + Just msg, false, false -> throwSingleError (Custom msg) <*> st.val + Just _, false, _ -> st.val + _, true, _ -> unrecognizedOpts st.state <*> st.val + _, _, _ -> st.val in {cmd, value} diff --git a/src/Node/Optlicative/Types.purs b/src/Node/Optlicative/Types.purs index 4a77d93..207e036 100644 --- a/src/Node/Optlicative/Types.purs +++ b/src/Node/Optlicative/Types.purs @@ -79,4 +79,4 @@ type Preferences a = { errorOnUnrecognizedOpts :: Boolean , usage :: Maybe String , globalOpts :: Optlicative a - } \ No newline at end of file + } diff --git a/test/Main.purs b/test/Main.purs index 6e27e3b..68a8eac 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -6,7 +6,7 @@ import Effect (Effect) import Effect.Console (log) import Data.List (length) import Data.Maybe (Maybe(..), maybe) -import Data.Validation.Semigroup (unV) +import Data.Validation.Semigroup (validation) import Node.Commando (Opt(Opt)) import Node.Optlicative (Optlicative, Preferences, defaultPreferences, flag, logErrors, optlicate, string, many) import Test.Types (Config(..), ConfigRec, showConfig) @@ -56,7 +56,7 @@ main = do (log "No path parsed") (\ x -> log "Path parsed" *> log x) cmd - unV + validation (\ x -> do log "Errors found: " log (show (length x) <> " errors") diff --git a/test/Types.purs b/test/Types.purs index d9bf905..f6e75b3 100644 --- a/test/Types.purs +++ b/test/Types.purs @@ -12,7 +12,7 @@ type ConfigRec = data Config = GlobalConfig GlobalConfig - | ConfigOne ConfigOne + | ConfigOne ConfigOne | ConfigTwo ConfigTwo showConfig :: Config -> String