symantic-cli 2.4.0.20190719 → 2.4.2.20190806

raw patch · 6 files changed

+50/−20 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Symantic/CLI/API.hs +23/−14
• Symantic/CLI/Help.hs +4/−2
• Symantic/CLI/Layout.hs +8/−0
• Symantic/CLI/Parser.hs +10/−2
• Symantic/CLI/Schema.hs +4/−1
• symantic-cli.cabal +1/−1

@@ -124,8 +124,6 @@ class CLI_Var repr where 	type VarConstraint repr a :: Constraint 	var' :: VarConstraint repr a => Name -> repr (a->k) k-	just :: a -> repr (a->k) k-	nothing :: repr k k 	-- Trans defaults 	type VarConstraint repr a = VarConstraint (UnTrans repr) a 	default var' ::@@ -133,17 +131,7 @@ 	 CLI_Var (UnTrans repr) => 	 VarConstraint (UnTrans repr) a => 	 Name -> repr (a->k) k-	default just ::-	 Trans repr =>-	 CLI_Var (UnTrans repr) =>-	 a -> repr (a->k) k-	default nothing ::-	 Trans repr =>-	 CLI_Var (UnTrans repr) =>-	 repr k k-	var'    = noTrans . var'-	just    = noTrans . just-	nothing = noTrans nothing+	var' = noTrans . var'  -- | Like 'var'' but with the type variable @(a)@ first instead or @(repr)@ -- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@.@@ -155,6 +143,27 @@ var = var' {-# INLINE var #-} +-- * Class 'CLI_Var'+class CLI_Constant repr where+	constant :: Segment -> a -> repr (a->k) k+	just     :: a -> repr (a->k) k+	nothing  :: repr k k+	default constant ::+	 Trans repr =>+	 CLI_Constant (UnTrans repr) =>+	 Segment -> a -> repr (a->k) k+	default just ::+	 Trans repr =>+	 CLI_Constant (UnTrans repr) =>+	 a -> repr (a->k) k+	default nothing ::+	 Trans repr =>+	 CLI_Constant (UnTrans repr) =>+	 repr k k+	constant s = noTrans . constant s+	just       = noTrans . just+	nothing    = noTrans nothing+ -- * Class 'CLI_Env' class CLI_Env repr where 	type EnvConstraint repr a :: Constraint@@ -191,7 +200,7 @@ 	 cs -> TagLong cs  -- * Class 'CLI_Tag'-class (App repr, Permutable repr, CLI_Var repr) => CLI_Tag repr where+class (App repr, Permutable repr, CLI_Constant repr) => CLI_Tag repr where 	type TagConstraint repr a :: Constraint 	tag :: Tag -> repr f k -> repr f k 	-- tag n = (tag n <.>)

@@ -169,8 +169,10 @@ instance SchemaDoc d => CLI_Var (Help d) where 	type VarConstraint (Help d) a = () 	var' n  = Help mempty (var' n)-	just a  = Help mempty (just a)-	nothing = Help mempty nothing+instance SchemaDoc d => CLI_Constant (Help d) where+	constant n a = Help mempty (constant n a)+	just a       = Help mempty (just a)+	nothing      = Help mempty nothing instance SchemaDoc d => CLI_Env (Help d) where 	type EnvConstraint (Help d) a = () 	env' n =

@@ -272,6 +272,14 @@ 			where h | List.null (layoutInh_message inh) = [] 			        | otherwise = [(docSchema sch, layoutInh_message inh)] 		where sch = var' n+instance LayoutDoc d => CLI_Constant (Layout d) where+	constant c a = Layout sch [] $ \inh -> do+		modify' $ \k -> \case+		 Nothing -> k Nothing+		 Just ts -> k $ Just [Tree.Node (LayoutNode_List [] h) ts]+			where h | List.null (layoutInh_message inh) = []+			        | otherwise = [(docSchema sch, layoutInh_message inh)]+		where sch = constant c a 	just a  = Layout (just a) [] $ \_inh -> pure () 	nothing = Layout nothing  [] $ \_inh -> pure () instance LayoutDoc d => CLI_Env (Layout d) where

@@ -42,6 +42,7 @@ import qualified Data.Map.Merge.Strict as Map import qualified Data.Map.Strict as Map import qualified Data.Set as Set+import qualified System.Exit as System import qualified Data.Text as Text import qualified Data.Text.IO as Text import qualified Data.Text.Lazy as TL@@ -73,6 +74,7 @@ 				"Error parsing the command at argument #" <> 				show (P.errorOffset e + 1) <> ":\n" <> 				parseErrorTextPretty e+			System.exitWith (System.ExitFailure 2) 	 Right app -> unResponseParser $ app handlers  -- | Rewrite 'P.parseErrorTextPretty' to keep 'Ord' of 'Arg'.@@ -205,6 +207,9 @@ 		 Right a -> return ($ a) 		where 		expName = Set.singleton $ P.Label $ NonEmpty.fromList $ "<"<>name<>">"+instance Ord e => CLI_Constant (Parser e d) where+	constant "" a = just a+	constant c  a = commands Map.empty (Map.singleton c (just a)) 	just a  = Parser $ return ($ a) 	nothing = Parser $ return id instance Ord e => CLI_Env (Parser e d) where@@ -322,7 +327,7 @@  , Reflection.Typeable a  ) => Outputable (Maybe a) where 	output = \case-	 Nothing -> return ()+	 Nothing -> System.exitWith (System.ExitFailure 1) 	 Just a  -> output a instance  ( Reflection.Typeable e@@ -331,7 +336,9 @@  , Outputable a  ) => Outputable (Either e a) where 	output = \case-	 Left e -> output $ OnHandle IO.stderr e+	 Left e -> do+		output (OnHandle IO.stderr e)+		System.exitWith (System.ExitFailure 1) 	 Right a -> output a  -- * Class 'IOType'@@ -528,6 +535,7 @@ 		 (Map.fromAscList $ (,x) <$> preCmds) 		 (Map.fromAscList $ (,x) <$> cmds) instance Ord e => CLI_Var (Router (Parser e d))+instance Ord e => CLI_Constant (Router (Parser e d)) instance Ord e => CLI_Env (Router (Parser e d)) instance Ord e => CLI_Tag (Router (Parser e d)) where 	tag = Router_Tag

@@ -58,7 +58,7 @@  =   SchemaInh  {   schemaInh_op     :: (Infix, Side) -- ^ Parent operator.  ,   schemaInh_define :: Bool          -- ^ Whether to print a definition, or not.- ,   schemaInh_or     :: d+ ,   schemaInh_or     :: d             -- ^ The separator to use between alternatives.  }  defSchemaInh :: SchemaDoc d => SchemaInh d@@ -228,6 +228,9 @@ 	type VarConstraint (Schema d) a = () 	var' n = Schema $ \_inh -> Just $ 		Doc.underline $ Doc.from $ Doc.Word n+instance SchemaDoc d => CLI_Constant (Schema d) where+	constant c _a = Schema $ \inh -> Just $+		Doc.from (Doc.Word c) 	just _  = Schema $ \_inh -> Nothing 	nothing = Schema $ \_inh -> Nothing instance SchemaDoc d => CLI_Env (Schema d) where

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 2.4.0.20190719+version: 2.4.2.20190806 category: System, CLI, Options, Parsing synopsis: Symantics for parsing and documenting a CLI description: