diff --git a/Language/Symantic/CLI.hs b/Language/Symantic/CLI.hs
deleted file mode 100644
--- a/Language/Symantic/CLI.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Language.Symantic.CLI
- ( module Language.Symantic.CLI.Sym
- ) where
-import Language.Symantic.CLI.Sym
diff --git a/Language/Symantic/CLI/Fixity.hs b/Language/Symantic/CLI/Fixity.hs
deleted file mode 100644
--- a/Language/Symantic/CLI/Fixity.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-module Language.Symantic.CLI.Fixity where
-
-import Data.Bool
-import Data.Eq (Eq(..))
-import Data.Function ((.))
-import Data.Int (Int)
-import Data.Maybe (Maybe(..))
-import Data.Ord (Ord(..))
-import Text.Show (Show(..))
-import qualified Data.Bool as Bool
-
--- * Type 'Fixity'
-data Fixity
- =   Fixity1 Unifix
- |   Fixity2 Infix
- deriving (Eq, Show)
-
--- ** Type 'Unifix'
-data Unifix
- =   Prefix  { unifix_prece :: Precedence }
- |   Postfix { unifix_prece :: Precedence }
- deriving (Eq, Show)
-
--- ** Type 'Infix'
-data Infix
- =   Infix
- {   infix_assoc :: Maybe Associativity
- ,   infix_prece :: Precedence
- } deriving (Eq, Show)
-
-infixL :: Precedence -> Infix
-infixL = Infix (Just AssocL)
-
-infixR :: Precedence -> Infix
-infixR = Infix (Just AssocR)
-
-infixB :: Side -> Precedence -> Infix
-infixB = Infix . Just . AssocB
-
-infixN :: Precedence -> Infix
-infixN = Infix Nothing
-
-infixN0 :: Infix
-infixN0 = infixN 0
-
-infixN5 :: Infix
-infixN5 = infixN 5
-
--- | Given 'Precedence' and 'Associativity' of its parent operator,
--- and the operand 'Side' it is in,
--- return whether an 'Infix' operator
--- needs to be enclosed by parenthesis.
-needsParenInfix :: (Infix, Side) -> Infix -> Bool
-needsParenInfix (po, lr) op =
-	infix_prece op < infix_prece po
-	|| infix_prece op == infix_prece po
-	&& Bool.not associate
-	where
-	associate =
-		case (lr, infix_assoc po) of
-		 (_, Just AssocB{})   -> True
-		 (SideL, Just AssocL) -> True
-		 (SideR, Just AssocR) -> True
-		 _ -> False
-
--- * Type 'Precedence'
-type Precedence = Int
-
--- ** Class 'PrecedenceOf'
-class PrecedenceOf a where
-	precedence :: a -> Precedence
-instance PrecedenceOf Fixity where
-	precedence (Fixity1 uni) = precedence uni
-	precedence (Fixity2 inf) = precedence inf
-instance PrecedenceOf Unifix where
-	precedence = unifix_prece
-instance PrecedenceOf Infix where
-	precedence = infix_prece
-
--- * Type 'Associativity'
-data Associativity
- =   AssocL      -- ^ Associate to the left:  @a ¹ b ² c == (a ¹ b) ² c@
- |   AssocR      -- ^ Associate to the right: @a ¹ b ² c == a ¹ (b ² c)@
- |   AssocB Side -- ^ Associate to both sides, but to 'Side' when reading.
- deriving (Eq, Show)
-
--- ** Type 'Side'
-data Side
- =   SideL -- ^ Left
- |   SideR -- ^ Right
- deriving (Eq, Show)
diff --git a/Language/Symantic/CLI/Help.hs b/Language/Symantic/CLI/Help.hs
deleted file mode 100644
--- a/Language/Symantic/CLI/Help.hs
+++ /dev/null
@@ -1,223 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Language.Symantic.CLI.Help where
-
-import Control.Applicative (Applicative(..))
-import Data.Bool
-import Data.Function (($), (.))
-import Data.Functor ((<$>))
-import Data.Functor.Compose (Compose(..))
-import Data.Maybe (Maybe(..), maybeToList, maybe)
-import Data.Monoid (Monoid(..))
-import Data.Semigroup (Semigroup(..))
-import qualified Language.Symantic.Document.Term as Doc
-import Data.Tree as Tree
-
-import Language.Symantic.CLI.Sym
-import qualified Language.Symantic.CLI.Plain as Plain
-
--- * Type 'Reader'
-data Reader d
- =   Reader
- {   reader_help           :: Maybe d
- ,   reader_command_indent :: Doc.Indent
- ,   reader_option_indent  :: Doc.Indent
- ,   reader_plain          :: Plain.Reader d
- ,   reader_option_empty   :: Bool
- }
-
-defReader :: Doc.Textable d => Reader d
-defReader = Reader
- { reader_help           = Nothing
- , reader_command_indent = 2
- , reader_option_indent  = 15
- , reader_plain          = Plain.defReader
- , reader_option_empty   = False
- }
-
--- * Type 'Result'
-type Result d = Tree.Forest (DocNode d)
-
-defResult :: Monoid d => Result d
-defResult = mempty
-
--- ** Type 'DocNode'
-data DocNode d
- =   Leaf
-     { docNodeSep    :: d
-     , docNode       :: d
-     }
- |   Indented
-     { docNodeIndent :: Doc.Indent
-     , docNodeSep    :: d
-     , docNode       :: d
-     }
- |   BreakableFill
-     { docNodeIndent :: Doc.Indent
-     , docNodeSep    :: d
-     , docNode       :: d
-     }
-
-docTree ::
- Monoid d =>
- Doc.Textable d =>
- Doc.Indentable d =>
- Tree (DocNode d) -> d
-docTree (Tree.Node n []) = docNode n
-docTree (Tree.Node n ts) =
-	case n of
-	 Leaf{} -> docNode n
-	 Indented      ind _sep d -> d <> Doc.incrIndent ind (Doc.newline <> docTrees ts)
-	 BreakableFill ind _sep d -> Doc.breakableFill ind d <> (Doc.align $ docTrees ts)
-
-docTrees ::
- Monoid d =>
- Doc.Textable d =>
- Doc.Indentable d =>
- Tree.Forest (DocNode d) -> d
-docTrees [] = Doc.empty
-docTrees [t] = docTree t
-docTrees (t0:ts) =
-	docTree t0 <> mconcat ((\t@(Tree.Node n _ns) -> docNodeSep n <> docTree t) <$> ts)
-
--- * Type 'Help'
-data Help d e t a
- =   Help
- {   help_result :: Reader d -> Result d
- ,   help_plain  :: Plain.Plain d e t a
- }
-
-runHelp :: Monoid d => Doc.Indentable d => Doc.Textable d => Help d e t a -> d
-runHelp h = docTrees $ help_result h defReader
-
-textHelp :: Plain.Doc d => Reader d -> Help d e t a -> d
-textHelp def (Help h _p) = docTrees $ h def
-
-coerceHelp :: Help d e s a -> Help d e t b
-coerceHelp Help{help_plain, ..} = Help
- { help_plain = Plain.coercePlain help_plain
- , ..
- }
-
-instance Doc.Textable d => Semigroup (Help d e s a) where
-	Help hx px <> Help hy py = Help (hx<>hy) (px<>py)
-instance (Doc.Textable d, Monoid d) => Monoid (Help d e s a) where
-	mempty  = Help mempty mempty
-	mappend = (<>)
-{-
-instance (Semigroup d, IsString d) => IsString (Help d e s a) where
-	fromString "" = Help $ \_ro -> Nothing
-	fromString s  = Help $ \_ro -> Just $ fromString s
-instance Show (Help Doc.Term e s a) where
-	show = TL.unpack . Doc.textTerm . textHelp
--}
-instance Plain.Doc d => Sym_Fun (Help d) where
-	f <$$> Help h p = Help h (f<$$>p)
-instance Plain.Doc d => Sym_App (Help d) where
-	value a = Help mempty (value a)
-	end     = Help mempty end
-	Help hf pf <**> Help hx px = Help (hf<>hx) (pf<**>px)
-instance Plain.Doc d => Sym_Alt (Help d) where
-	Help hl pl <||> Help hr pr = Help (hl<>hr) (pl<||>pr)
-	try (Help h p) = Help h (try p)
-	choice hs = Help (mconcat $ help_result <$> hs) (choice (help_plain <$> hs))
-	option a (Help h p) = Help h (option a p)
-instance Plain.Doc d => Sym_AltApp (Help d) where
-	many (Help h p) = Help h (many p)
-	some (Help h p) = Help h (many p)
--- * Type 'PermHelp'
-data PermHelp d e t a
- =   PermHelp (Reader d -> Result d)
-              [Plain.Plain d e t a]
-type instance Perm (Help d e t) = PermHelp d e t
-instance Plain.Doc d => Sym_Interleaved (Help d) where
-	interleaved (PermHelp h ps) = Help h $ interleaved $ Compose ps
-	f <<$>>      Help h p       = PermHelp h $ getCompose $ f<<$>>p
-	f <<$?>> (a, Help h p)      = PermHelp h $ getCompose $ f<<$?>>(a,p)
-	f <<$*>>     Help h p       = PermHelp h $ getCompose $ f<<$*>>p
-	PermHelp hl pl <<|>>      Help hr pr  = PermHelp (hl<>hr) $ getCompose $ Compose pl<<|>>pr
-	PermHelp hl pl <<|?>> (a, Help hr pr) = PermHelp (hl<>hr) $ getCompose $ Compose pl<<|?>>(a,pr)
-	PermHelp hl pl <<|*>>     Help hr pr  = PermHelp (hl<>hr) $ getCompose $ Compose pl<<|*>>pr
-instance Plain.Doc d => Sym_Rule (Help d) where
-	rule n (Help h p) =
-		Help (\ro ->
-			pure $
-			Tree.Node (Indented
-			 (reader_command_indent ro)
-			 (Doc.newline <> Doc.newline) $
-				ref<>" ::= "<>Plain.runPlain p' (reader_plain ro)) $
-			maybeToList (pure . Leaf Doc.empty <$> reader_help ro) <>
-			h ro{reader_help=Nothing}
-		 ) p'
-		where
-		p' = rule n p
-		ref =
-			Doc.bold $
-			Doc.between (Doc.charH '<') (Doc.charH '>') $
-			Doc.magentaer $
-			Doc.stringH n
-instance Plain.Doc d => Sym_Option (Help d) where
-	var n f = Help mempty (var n f)
-	tag n = Help mempty (tag n)
-	opt n (Help _h p) =
-		Help (\ro ->
-			case reader_help ro of
-			 Nothing ->
-				if reader_option_empty ro
-				then
-					pure $ pure $ Leaf Doc.newline $ Doc.bold $
-					Plain.runPlain p' (reader_plain ro)
-				else []
-			 Just msg ->
-				pure $
-				Tree.Node
-				 (BreakableFill
-					 (reader_option_indent ro)
-					 Doc.newline
-					 (Doc.bold $ Plain.runPlain p' (reader_plain ro) <> Doc.space)) $
-				pure $ pure $ Leaf Doc.empty msg
-		 ) p'
-		where p' = opt n p
-instance Plain.Doc d => Sym_Help d (Help d) where
-	help msg (Help h p) = Help
-	 (\ro -> h ro{reader_help=Just msg})
-	 (Language.Symantic.CLI.Sym.help msg p)
-instance Plain.Doc d => Sym_Command (Help d) where
-	main n (Help h p) =
-		Help (\ro ->
-			pure $
-			Tree.Node (Indented 0
-				 (Doc.newline <> Doc.newline) $
-				 Plain.runPlain p' (reader_plain ro) <>
-					maybe Doc.empty
-					 (\d -> Doc.newline <> Doc.newline <> d <> Doc.newline)
-					 (reader_help ro)
-			 ) $
-			h ro{reader_help=Nothing}
-		 ) p'
-		where p' = main n p
-	command n (Help h p) =
-		Help (\ro ->
-			pure $
-			Tree.Node
-			 (Indented
-				 (reader_command_indent ro)
-				 (Doc.newline <> Doc.newline) $
-					ref<>" ::= " <>
-					Plain.runPlain p' (reader_plain ro) <>
-					maybe Doc.empty
-					 ( (<> Doc.newline)
-					 . Doc.incrIndent (reader_command_indent ro)
-					 . (Doc.newline <>) )
-					 (reader_help ro)
-			 ) $
-			h ro{reader_help=Nothing}
-		 ) p'
-		where
-		p' = command n p
-		ref =
-			Doc.bold $
-			Doc.between (Doc.charH '<') (Doc.charH '>') $
-			Doc.magentaer $
-			Doc.stringH n
-instance Plain.Doc d => Sym_Exit (Help d) where
-	exit e = Help mempty $ exit e
diff --git a/Language/Symantic/CLI/Plain.hs b/Language/Symantic/CLI/Plain.hs
deleted file mode 100644
--- a/Language/Symantic/CLI/Plain.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Language.Symantic.CLI.Plain where
-
-import Data.Bool
-import Data.Function (($), (.))
-import Data.Functor ((<$>))
-import Data.Functor.Compose (Compose(..))
-import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
-import Data.Monoid (Monoid(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (String, IsString(..))
-import Text.Show (Show(..))
-import qualified Data.Text.Lazy as TL
-import qualified Language.Symantic.Document.Term as Doc
-import qualified Language.Symantic.Document.Term.IO as DocIO
-
-import Language.Symantic.CLI.Sym
-import Language.Symantic.CLI.Fixity
-
--- * Class 'Doc'
-class
- ( IsString d
- , Semigroup d
- , Monoid d
- , Doc.Textable d
- , Doc.Indentable d
- , Doc.Breakable d
- , Doc.Colorable d
- , Doc.Decorable d
- ) =>
- Doc d
-instance Doc Doc.Term
-instance Doc DocIO.TermIO
-
-words :: Doc.Textable d => Doc.Breakable d => String -> d
-words m = Doc.breakableSpaces $ Doc.string <$> Doc.words m
-
--- * Type 'Reader'
--- | Constructed top-down
-data Reader d
- =   Reader
- {   reader_op             :: (Infix, Side) -- ^ Parent operator.
- ,   reader_define         :: Bool          -- ^ Whether to print a definition, or not.
- ,   reader_or             :: d
- }
-
-defReader :: Doc.Textable d => Reader d
-defReader = Reader
- { reader_op             = (infixN0, SideL)
- , reader_define         = True
- , reader_or             = Doc.stringH " | "
- }
-
-pairIfNeeded :: Doc d => Reader d -> Infix -> d -> d
-pairIfNeeded Reader{..} op d =
-	if needsParenInfix reader_op op
-	then Doc.align $ Doc.between (Doc.charH '(') (Doc.charH ')') d
-	else d
-
--- * Type 'Plain'
-newtype Plain d e t a
- =      Plain { unPlain :: Reader d -> Maybe d }
-
-runPlain :: Monoid d => Plain d e t a -> Reader d -> d
-runPlain (Plain p) = fromMaybe mempty . p
-
-coercePlain :: Plain d e t a -> Plain d e u b
-coercePlain Plain{..} = Plain{..}
-
-textPlain :: Monoid d => Doc.Textable d => Plain d e t a -> d
-textPlain p = runPlain p defReader
-
-instance Semigroup d => Semigroup (Plain d e t a) where
-	Plain x <> Plain y = Plain $ x <> y
-instance (Semigroup d, Monoid d) => Monoid (Plain d e t a) where
-	mempty  = Plain mempty
-	mappend = (<>)
-instance (Semigroup d, IsString d) => IsString (Plain d e t a) where
-	fromString "" = Plain $ \_ro -> Nothing
-	fromString s  = Plain $ \_ro -> Just $ fromString s
-instance Show (Plain Doc.Term e t a) where
-	show = TL.unpack . Doc.textTerm . textPlain
-instance Doc d => Sym_Fun (Plain d) where
-	_f <$$> Plain x = Plain $ \ro ->
-		pairIfNeeded ro op <$>
-		x ro{reader_op=(op, SideR)}
-		where
-		op = infixB SideL 10
-instance Doc d => Sym_App (Plain d) where
-	value _ = Plain $ \_ro -> Nothing
-	end     = Plain $ \_ro -> Nothing
-	Plain f <**> Plain x = Plain $ \ro ->
-		case (f ro{reader_op=(op, SideL)}, x ro{reader_op=(op, SideR)}) of
-		 (Nothing, Nothing) -> Nothing
-		 (Just f', Nothing) -> Just f'
-		 (Nothing, Just x') -> Just x'
-		 (Just f', Just x') -> Just $ pairIfNeeded ro op $ f' <> Doc.space <> x'
-		where
-		op = infixB SideL 10
-instance Doc d => Sym_Alt (Plain d) where
-	lp <||> rp = Plain $ \ro ->
-		Just $
-		if needsParenInfix (reader_op ro) op
-		then
-			Doc.ifBreak
-			 (Doc.align $
-				Doc.between (Doc.charH '(') (Doc.charH ')') $
-				Doc.space <>
-				runPlain lp ro{reader_op=(op, SideL), reader_or=Doc.newline<>Doc.charH '|'<>Doc.space} <>
-				Doc.newline <>
-				Doc.stringH "| " <>
-				runPlain rp ro{reader_op=(op, SideR), reader_or=Doc.newline<>Doc.charH '|'<>Doc.space} <>
-				Doc.newline)
-			 (Doc.between (Doc.charH '(') (Doc.charH ')') $
-				Doc.withBreakable Nothing $
-				runPlain lp ro{reader_op=(op, SideL), reader_or=Doc.stringH " | "} <>
-				Doc.stringH " | " <>
-				runPlain rp ro{reader_op=(op, SideR), reader_or=Doc.stringH " | "})
-		else
-			runPlain lp ro{reader_op=(op, SideL)} <>
-			reader_or ro <>
-			runPlain rp ro{reader_op=(op, SideR)}
-		where op = infixB SideL 2
-	try p = p
-	choice [] = "<none>"
-	choice [p] = p
-	choice l@(_:_) = Plain $ \ro -> Just $
-		pairIfNeeded ro op $
-		Doc.foldWith ("\n| " <>) $
-		(($ ro{reader_op=(op, SideL)}) . runPlain) <$> l
-		where op = infixB SideL 2
-	option _a p = Plain $ \ro -> Just $
-		if needsParenInfix (reader_op ro) op
-		then
-			Doc.ifBreak
-			 (Doc.align $
-				Doc.between (Doc.charH '[') (Doc.charH ']') $
-				Doc.space <>
-				runPlain p ro{reader_op=(op, SideL)} <>
-				Doc.newline)
-			 (Doc.between (Doc.charH '[') (Doc.charH ']') $
-				Doc.withBreakable Nothing $
-				runPlain p ro{reader_op=(op, SideL), reader_or=Doc.stringH " | "})
-		else
-			runPlain p ro{reader_op=(op, SideL)}
-		where op = infixN0
-instance Doc d => Sym_AltApp (Plain d) where
-	many p = Plain $ \ro -> Just $
-		runPlain p ro{reader_op=(op, SideL)}<>"*"
-		where op = infixN 10
-	some p = Plain $ \ro -> Just $
-		runPlain p ro{reader_op=(op, SideL)}<>"+"
-		where op = infixN 10
-type instance Perm (Plain d e t) = Compose [] (Plain d e t)
-instance Doc d => Sym_Interleaved (Plain d) where
-	interleaved (Compose []) = "<none>"
-	interleaved (Compose [Plain p]) = Plain p
-	interleaved (Compose l@(_:_)) = Plain $ \ro -> Just $
-		-- pairIfNeeded ro op $
-		Doc.align $
-		Doc.foldWith Doc.breakableSpace $
-		catMaybes $
-		(\(Plain p) ->
-			p ro
-			 { reader_op=(op, SideL)
-			 , reader_or=Doc.stringH " | " }
-		) <$> l
-		where op = infixN 10
-	_f <<$>>      Plain p          = Compose [Plain p]
-	_f <<$?>> (_, Plain p)         = Compose [coercePlain $ optional $ Plain p]
-	_f <<$*>>     Plain p          = Compose [coercePlain $ many     $ Plain p]
-	Compose ws <<|>>      Plain p  = Compose $ coercePlain <$> ws <> [Plain p]
-	Compose ws <<|?>> (_, Plain p) = Compose $ coercePlain <$> ws <> [coercePlain $ optional $ Plain p]
-	Compose ws <<|*>>     Plain p  = Compose $ coercePlain <$> ws <> [coercePlain $ many     $ Plain p]
-instance Doc d => Sym_Rule (Plain d) where
-	rule n p = Plain $ \ro -> Just $
-		if reader_define ro
-		then runPlain p ro{reader_define=False}
-		else ref
-		where
-		ref =
-			Doc.bold $
-			Doc.between (Doc.charH '<') (Doc.charH '>') $
-			Doc.magentaer $
-			Doc.stringH n
-instance Doc d => Sym_Option (Plain d) where
-	var n _f = Plain $ \_ro -> Just $ Doc.between (Doc.charH '<') (Doc.charH '>') (Doc.string n)
-	tag = fromString
-	opt n r = Plain $ \ro ->
-		unPlain (prefix n <**> coercePlain r) ro
-		where
-		prefix = \case
-		 OptionName      s l -> prefix (OptionNameShort s)<>"|"<>prefix (OptionNameLong l)
-		 OptionNameShort s   -> fromString ['-', s]
-		 OptionNameLong  l   -> fromString ("--"<>l)
-instance Doc d => Sym_Command (Plain d) where
-	main n r = Plain $ \ro -> Just $
-		if reader_define ro
-		then
-			runPlain
-			 (fromString n <**> coercePlain r)
-			 ro{reader_define = False}
-		else ref
-		where
-		ref =
-			Doc.bold $
-			Doc.between (Doc.charH '<') (Doc.charH '>') $
-			Doc.magentaer $
-			Doc.stringH n
-	command = main
-instance Doc d => Sym_Help d (Plain d) where
-	help _msg p = p
-instance Doc d => Sym_Exit (Plain d) where
-	exit _ = Plain $ \_ro -> Nothing
diff --git a/Language/Symantic/CLI/Read.hs b/Language/Symantic/CLI/Read.hs
deleted file mode 100644
--- a/Language/Symantic/CLI/Read.hs
+++ /dev/null
@@ -1,163 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Language.Symantic.CLI.Read where
-
-import Control.Applicative (Applicative(..), Alternative(..))
-import Control.Arrow ((***))
-import Control.Monad (Monad(..), MonadPlus(..))
-import Data.Bool
-import Data.Either (Either(..))
-import Data.Eq (Eq(..))
-import Data.Foldable (Foldable(..))
-import Data.Function (($), (.))
-import Data.Functor (Functor(..), (<$>))
-import Data.Maybe (Maybe(..))
-import Data.Monoid (Monoid(..))
-import Data.Ord (Ord(..), Ordering(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (String)
-import Text.Show (Show(..))
-import qualified Data.List as List
-import qualified Data.Set as Set
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Perm as P
-
-import Language.Symantic.CLI.Sym as Sym
-
--- * Type 'Arg'
-newtype Arg = Arg { unArg :: String }
- deriving (Eq, Ord, Show)
-
--- * Type 'Args'
-newtype Args = Args { unArgs :: [Arg] }
- deriving (Eq, Ord, Show, Semigroup, Monoid)
-instance P.Stream Args where
-	type Token  Args = Arg
-	type Tokens Args = Args
-	tokenToChunk _s  = Args . pure
-	tokensToChunk _s = Args
-	chunkToTokens _s = unArgs
-	chunkLength _s   = List.length . unArgs
-	chunkEmpty _s    = List.null . unArgs
-	advance1 _s _ind (P.SourcePos n l c) _ = P.SourcePos n l (c <> P.pos1)
-	advanceN s ind pos = foldl' (P.advance1 s ind) pos . unArgs
-	take1_ as =
-		case unArgs as of
-		 []   -> Nothing
-		 t:ts -> Just (t, Args ts)
-	takeN_ n as | n <= 0    = Just (Args [], as)
-	            | null (unArgs as) = Nothing
-	            | otherwise = Just $ (Args *** Args) $ List.splitAt n $ unArgs as
-	takeWhile_ f = (Args *** Args) . List.span f . unArgs
-instance P.ShowToken Arg where
-	showTokens toks =
-		List.intercalate ", " $ toList $ showArg <$> toks
-		where
-		showArg :: Arg -> String
-		showArg (Arg a@('-':_)) = a
-		showArg (Arg a) = "\""<>a<>"\""
-
--- * Type 'Parser'
-newtype Parser e s a
- =      Parser { unParser :: P.Parsec (ErrorRead e) Args a }
- deriving (Functor, Applicative, Alternative, Monad, MonadPlus, P.MonadParsec (ErrorRead e) Args)
-
-coerceParser :: Parser e s a -> Parser e t a
-coerceParser = Parser . unParser
-
-instance Sym_Fun Parser where
-	f <$$> Parser a = Parser $ f <$> a
-instance Sym_App Parser where
-	value = Parser . pure
-	end = Parser P.eof
-	Parser f <**> Parser a = Parser $ f <*> a
-instance Sym_Alt Parser where
-	(<||>)   = (P.<|>)
-	optional = P.optional
-	option   = P.option
-	choice   = P.choice
-	try      = P.try
-instance Sym_AltApp Parser where
-	many = P.many
-	some = P.some
-type instance Perm (Parser e s) = P.PermParser Args (Parser e s)
-instance Sym_Interleaved Parser where
-	interleaved = P.makePermParser
-	(<<$>>)     = (P.<$$>)
-	(<<|>>)     = (P.<||>)
-	(<<$?>>)    = (P.<$?>)
-	(<<|?>>)    = (P.<|?>)
-	f <<$*>> a  = f P.<$?> ([],P.some a)
-	f <<|*>> a  = f P.<|?> ([],P.some a)
-instance Sym_Command Parser where
-	main = command
-	command n p = P.token check (Just expected) *> coerceParser p
-		where
-		expected = Arg n
-		check a | a == expected = Right ()
-		check t = Left
-		 ( Just $ P.Tokens $ pure t
-		 , Set.singleton $ P.Tokens $ pure expected )
-instance Sym_Option Parser where
-	var n f = do
-		let check = Right
-		let expected | List.null n = Arg "<string>"
-		             | otherwise   = Arg $ "<"<>n<>">"
-		Arg arg <- P.token check (Just expected)
-		case f arg of
-		 Right a -> return a
-		 Left err -> P.customFailure $ ErrorRead err
-	tag n = do
-		let expected = Arg n
-		let check t | t == expected = Right ()
-		            | otherwise     = Left ( Just $ P.Tokens $ pure t
-		                                   , Set.singleton $ P.Tokens $ pure expected )
-		P.token check (Just expected)
-	opt n p =
-		(*> coerceParser p) $
-		case n of
-		 OptionNameLong l ->
-			P.token (checkLong l) (Just $ expectedLong l)
-		 OptionNameShort s ->
-			P.token (checkShort s) (Just $ expectedShort s)
-		 OptionName s l ->
-			P.token (checkShort s) (Just $ expectedShort s) <|>
-			P.token (checkLong l)  (Just $ expectedLong l)
-		where
-		expectedShort s = Arg ['-', s]
-		checkShort s a | a == expectedShort s = Right ()
-		checkShort s t = Left
-		 ( Just $ P.Tokens $ pure t
-		 , Set.singleton $ P.Tokens $ pure $ expectedShort s)
-		expectedLong l = Arg $ "--"<>l
-		checkLong l a | a == expectedLong l = Right ()
-		checkLong l t = Left
-		 ( Just $ P.Tokens $ pure t
-		 , Set.singleton $ P.Tokens $ pure $ expectedLong l)
-instance Sym_Help d Parser where
-	help _msg p = p
-instance Sym_Rule Parser where
-	rule _n = coerceParser
-instance Sym_Exit Parser where
-	exit e =
-		Parser $
-			P.fancyFailure $ Set.singleton $
-				P.ErrorCustom $ ErrorRead e
-
--- * Type 'ErrorRead'
-newtype ErrorRead e
- =      ErrorRead e
- deriving (Functor)
-instance Show e => Show (ErrorRead e) where
-	showsPrec p (ErrorRead e) = showsPrec p e
-instance Eq (ErrorRead a) where
-	_==_ = True
-instance Ord (ErrorRead a) where
-	_`compare`_ = EQ
-instance Show e => P.ShowErrorComponent (ErrorRead e) where
-	showErrorComponent = show
-
-readArgs :: Parser e s a -> Args -> Either (P.ParseError (P.Token Args) (ErrorRead e)) a
-readArgs p = P.runParser (unParser $ p <* end) ""
diff --git a/Language/Symantic/CLI/Sym.hs b/Language/Symantic/CLI/Sym.hs
deleted file mode 100644
--- a/Language/Symantic/CLI/Sym.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-{-# LANGUAGE TypeFamilyDependencies #-}
-module Language.Symantic.CLI.Sym where
-
-import Data.Bool
-import Data.Char (Char)
-import Data.Either (Either(..))
-import Data.Eq (Eq)
-import Data.Function (($), (.), const, id)
-import Data.Functor ((<$>))
-import Data.Maybe (Maybe(..), catMaybes)
-import Data.Ord (Ord(..))
-import Data.String (String)
-import Text.Show (Show)
-
--- * @Arg@ types
--- | Types to type the symantics:
--- eg. to segregate options from commands.
-data ArgCommand
-data ArgOption
-data ArgValue
-data ArgRule t
-
--- * Type 'Name'
-type Name = String
-
--- * Class 'Sym_Fun'
-class Sym_Fun repr where
-	(<$$>) :: (a -> b) -> repr e t a -> repr e t b
-	(<$$)  :: a -> repr e t b -> repr e t a
-	(<$$) = (<$$>) . const
-	($$>)  :: repr e t b -> a -> repr e t a
-	r $$> a = const a <$$> r
--- * Class 'Sym_App'
-class Sym_Fun repr => Sym_App repr where
-	value     :: a -> repr e ArgValue a
-	(<**>)    :: repr e t (a -> b) -> repr e u a -> repr e u b
-	(**>)     :: repr e t a -> repr e u b -> repr e u b
-	a **> b = id <$$ a <**> b
-	(<**)     :: repr e t a -> repr e u b -> repr e u a
-	a <** b = const <$$> a <**> b
-	end       :: repr e t ()
--- * Class 'Sym_Alt'
-class Sym_Fun repr => Sym_Alt repr where
-	(<||>)    :: repr e t a -> repr e t a -> repr e t a
-	choice    :: [repr e t a] -> repr e t a
-	optional  :: repr e t a -> repr e t (Maybe a)
-	optional a = option Nothing (Just <$$> a)
-	option    :: a -> repr e t a -> repr e t a
-	try       :: repr e t a -> repr e t a
--- * Class 'Sym_AltApp'
-class (Sym_Alt repr, Sym_App repr) => Sym_AltApp repr where
-	many      :: repr e t a -> repr e t [a]
-	some      :: repr e t a -> repr e t [a]
-	-- default intermany :: (Sym_Alt repr, Sym_App repr) => [repr e t a] -> repr e t [a]
-	intermany :: [repr e t a] -> repr e t [a]
-	intermany = many . choice . (try <$>)
--- * Class 'Sym_Interleaved'
-class Sym_Interleaved repr where
-	interleaved :: Perm (repr e t) a -> repr e t a
-	(<<$>>)  :: (a -> b) -> repr e t a -> Perm (repr e t) b
-	(<<$?>>) :: (a -> b) -> (a, repr e t a) -> Perm (repr e t) b
-	(<<$*>>) :: ([a] -> b) -> repr e t a -> Perm (repr e t) b
-	(<<|>>)  :: Perm (repr e t) (a -> b) -> repr e t a -> Perm (repr e t) b
-	(<<|?>>) :: Perm (repr e t) (a -> b) -> (a, repr e t a) -> Perm (repr e t) b
-	(<<|*>>) :: Perm (repr e t) ([a] -> b) -> repr e t a -> Perm (repr e t) b
-	
-	(<<$) :: a -> repr e t b -> Perm (repr e t) a
-	(<<$) = (<<$>>) . const
-	(<<$?) :: a -> (b, repr e t b) -> Perm (repr e t) a
-	a <<$? b = const a <<$?>> b
-	{- NOTE: cannot be done without and instance:
-	 - Functor (P.PermParser s m)
-	(<<|)  :: Functor (Perm (repr e t)) => Perm (repr e t) a -> repr e t b -> Perm (repr e t) a
-	(<<|?) :: Functor (Perm (repr e t)) => Perm (repr e t) a -> (b, repr e t b) -> Perm (repr e t) a
-	a <<|  b = (const <$> a) <<|>> b
-	a <<|? b = (const <$> a) <<|?>> b
-	-}
-infixl 4 <$$>
-infixl 4 <**>
-infixl 3 <||>
-infixl 2 <<$>>, <<$?>>, <<$*>>
-infixl 1 <<|>>, <<|?>>, <<|*>>
--- ** Type family 'Perm'
-type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr
--- * Class 'Sym_Rule'
-class Sym_Rule repr where
-	rule :: String -> repr e t a -> repr e t a
-	-- rule _n = id
--- * Class 'Sym_Command'
-class Sym_Command repr where
-	main       :: Name -> repr e t a -> repr e ArgCommand a
-	command    :: Name -> repr e t a -> repr e ArgCommand a
--- * Class 'Sym_Option'
-class Sym_AltApp repr => Sym_Option repr where
-	opt    :: OptionName -> repr e s a -> repr e ArgOption a
-	var    :: Name -> (String -> Either e a) -> repr e ArgValue a
-	tag    :: String -> repr e ArgValue ()
-	-- int    :: repr e ArgValue Int
-	
-	long   :: Name -> repr e ArgValue a -> repr e ArgOption a
-	short  :: Char -> repr e ArgValue a -> repr e ArgOption a
-	flag   :: OptionName -> (Bool, repr e ArgOption Bool)
-	endOpt :: repr e ArgOption ()
-	string :: Name -> repr e ArgValue String
-	long   = opt . OptionNameLong
-	short  = opt . OptionNameShort
-	flag n = (False,) $ opt n $ value True
-	endOpt = option () $ opt (OptionNameLong "") $ value ()
-	string n = var n Right
--- ** Type 'OptionName'
-data OptionName
- =   OptionName Char Name
- |   OptionNameLong Name
- |   OptionNameShort Char
- deriving (Eq, Show)
-instance Ord OptionName where
-	x`compare`y =
-		catMaybes [longOf x, shortOf x]
-		`compare`
-		catMaybes [longOf y, shortOf y]
-		where
-		longOf = \case
-		 OptionName _s l -> Just l
-		 OptionNameLong l -> Just l
-		 OptionNameShort _s -> Nothing
-		shortOf = \case
-		 OptionName s _l -> Just [s]
-		 OptionNameLong _l -> Nothing
-		 OptionNameShort s -> Just [s]
--- * Class 'Sym_Help'
-class Sym_Help d repr where
-	help :: d -> repr e t a -> repr e t a
--- * Class 'Sym_Exit'
-class Sym_Exit repr where
-	exit :: e -> repr e t ()
diff --git a/Symantic/CLI/API.hs b/Symantic/CLI/API.hs
new file mode 100644
--- /dev/null
+++ b/Symantic/CLI/API.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE UndecidableInstances #-} -- for type instance defaults
+module Symantic.CLI.API where
+
+import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Char (Char)
+import Data.Eq (Eq)
+import Data.Function (($), (.), id)
+import Data.Int (Int)
+import Data.Kind (Constraint)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (Monoid)
+import Data.String (String)
+import Data.Text (Text)
+import Text.Show (Show)
+import Data.Functor (Functor(..), (<$>))
+
+-- * Class 'App'
+class App repr where
+	(<.>) :: repr a b -> repr b c -> repr a c
+	-- Trans defaults
+	default (<.>) ::
+	 Trans repr =>
+	 App (UnTrans repr) =>
+	 repr a b -> repr b c -> repr a c
+	x <.> y = noTrans (unTrans x <.> unTrans y)
+infixr 4 <.>
+
+-- * Class 'Alt'
+class Alt repr where
+	(<!>) :: repr a k -> repr b k -> repr (a:!:b) k
+	-- Trans defaults
+	default (<!>) ::
+	 Trans repr =>
+	 Alt (UnTrans repr) =>
+	 repr a k -> repr b k -> repr (a:!:b) k
+	x <!> y = noTrans (unTrans x <!> unTrans y)
+	opt :: repr (a->k) k -> repr (Maybe a->k) k
+infixr 3 <!>
+
+-- ** Type (':!:')
+-- | Like @(,)@ but @infixr@.
+data (:!:) a b = a:!:b
+infixr 3 :!:
+
+-- * Class 'Pro'
+class Pro repr where
+	dimap :: (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
+	-- Trans defaults
+	default dimap ::
+	 Trans repr =>
+	 Pro (UnTrans repr) =>
+	 (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
+	dimap a2b b2a = noTrans . dimap a2b b2a . unTrans
+
+-- * Class 'AltApp'
+class AltApp repr where
+	many0 :: repr (a->k) k -> repr ([a]->k) k
+	many1 :: repr (a->k) k -> repr ([a]->k) k
+	default many0 ::
+	 Trans repr =>
+	 AltApp (UnTrans repr) =>
+	 repr (a->k) k -> repr ([a]->k) k
+	default many1 ::
+	 Trans repr =>
+	 AltApp (UnTrans repr) =>
+	 repr (a->k) k -> repr ([a]->k) k
+	many0   = noTrans . many0 . unTrans
+	many1   = noTrans . many1 . unTrans
+
+-- * Class 'Permutable'
+class Permutable repr where
+	-- Use @TypeFamilyDependencies@ to help type-inference infer @(repr)@.
+	type Permutation (repr:: * -> * -> *) = (r :: * -> * -> *) | r -> repr
+	type Permutation repr = Permutation (UnTrans repr)
+	runPermutation :: Permutation repr k a -> repr (a->k) k
+	toPermutation :: repr (a->k) k -> Permutation repr k a
+	toPermDefault :: a -> repr (a->k) k -> Permutation repr k a
+
+-- | Convenient wrapper to omit a 'runPermutation'.
+--
+-- @
+-- opts '<?>' next = 'runPermutation' opts '<.>' next
+-- @
+(<?>) ::
+ App repr => Permutable repr =>
+ Permutation repr b a -> repr b c -> repr (a->b) c
+opts <?> next = runPermutation opts <.> next
+infixr 4 <?>
+
+-- * Type 'Name'
+type Name = String
+
+-- * Type 'Segment'
+type Segment = String
+
+-- * Class 'CLI_Command'
+class CLI_Command repr where
+	command :: Name -> repr a k -> repr a k
+
+-- * Class 'CLI_Var'
+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' ::
+	 Trans repr =>
+	 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
+
+-- | Like 'var'' but with the type variable @(a)@ first instead or @(repr)@
+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@.
+var ::
+ forall a k repr.
+ CLI_Var repr =>
+ VarConstraint repr a =>
+ Name -> repr (a->k) k
+var = var'
+{-# INLINE var #-}
+
+-- * Class 'CLI_Env'
+class CLI_Env repr where
+	type EnvConstraint repr a :: Constraint
+	env' :: EnvConstraint repr a => Name -> repr (a->k) k
+	-- Trans defaults
+	type EnvConstraint repr a = EnvConstraint (UnTrans repr) a
+	default env' ::
+	 Trans repr =>
+	 CLI_Env (UnTrans repr) =>
+	 EnvConstraint (UnTrans repr) a =>
+	 Name -> repr (a->k) k
+	env' = noTrans . env'
+
+-- | Like 'env'' but with the type enviable @(a)@ first instead or @(repr)@
+-- so it can be passed using 'TypeApplications' without adding a |\@_| for @(repr)@.
+env ::
+ forall a k repr.
+ CLI_Env repr =>
+ EnvConstraint repr a =>
+ Name -> repr (a->k) k
+env = env'
+{-# INLINE env #-}
+
+-- ** Type 'Tag'
+data Tag
+ =   Tag Char Name
+ |   TagLong Name
+ |   TagShort Char
+ deriving (Eq, Show)
+
+-- * Class 'CLI_Tag'
+class (App repr, Permutable repr, CLI_Var repr) => CLI_Tag repr where
+	type TagConstraint repr a :: Constraint
+	tagged :: Tag -> repr f k -> repr f k
+	endOpts :: repr k k
+	
+	-- tagged n = (tag n <.>)
+	short :: TagConstraint repr a => Char -> repr (a->k) k -> Permutation repr k a
+	short n = toPermutation . tagged (TagShort n)
+	long :: TagConstraint repr a => Name -> repr (a->k) k -> Permutation repr k a
+	long n = toPermutation . tagged (TagLong n)
+	
+	option :: TagConstraint repr a => a -> repr (a->k) k -> Permutation repr k a
+	option = toPermDefault
+	flag :: TagConstraint repr Bool => Tag -> Permutation repr k Bool
+	flag n = toPermDefault False $ tagged n $ just True
+	shortOpt :: TagConstraint repr a => Char -> a -> repr (a->k) k -> Permutation repr k a
+	shortOpt n a = toPermDefault a . tagged (TagShort n)
+	longOpt :: TagConstraint repr a => Name -> a -> repr (a->k) k -> Permutation repr k a
+	longOpt n a = toPermDefault a . tagged (TagLong n)
+	
+	-- Trans defaults
+	type TagConstraint repr a = TagConstraint (UnTrans repr) a
+	default tagged ::
+	 Trans repr =>
+	 CLI_Tag (UnTrans repr) =>
+	 Tag -> repr f k -> repr f k
+	default endOpts ::
+	 Trans repr =>
+	 CLI_Tag (UnTrans repr) =>
+	 repr k k
+	tagged n = noTrans . tagged n . unTrans
+	endOpts = noTrans endOpts
+
+-- * Class 'CLI_Response'
+class CLI_Response repr where
+	type ResponseConstraint repr a :: Constraint
+	type ResponseArgs repr a :: * -- = (r:: *) | r -> a
+	type Response repr :: *
+	response' ::
+	 ResponseConstraint repr a =>
+	 repr (ResponseArgs repr a)
+	      (Response repr)
+	-- Trans defaults
+	type ResponseConstraint repr a = ResponseConstraint (UnTrans repr) a
+	type ResponseArgs repr a = ResponseArgs (UnTrans repr) a
+	type Response repr = Response (UnTrans repr)
+	default response' ::
+	 forall a.
+	 Trans repr =>
+	 CLI_Response (UnTrans repr) =>
+	 ResponseConstraint (UnTrans repr) a =>
+	 ResponseArgs repr a ~ ResponseArgs (UnTrans repr) a =>
+	 Response repr ~ Response (UnTrans repr) =>
+	 repr (ResponseArgs repr a)
+	      (Response repr)
+	response' = noTrans (response' @_ @a)
+
+response ::
+ forall a repr.
+ CLI_Response repr =>
+ ResponseConstraint repr a =>
+ repr (ResponseArgs repr a)
+      (Response repr)
+response = response' @repr @a
+{-# INLINE response #-}
+
+-- * Class 'CLI_Help'
+class CLI_Help repr where
+	type HelpConstraint repr d :: Constraint
+	help :: HelpConstraint repr d => d -> repr f k -> repr f k
+	help _msg = id
+	program :: Name -> repr f k -> repr f k
+	rule :: Name -> repr f k -> repr f k
+	-- Trans defaults
+	type HelpConstraint repr d = HelpConstraint (UnTrans repr) d
+	default program ::
+	 Trans repr =>
+	 CLI_Help (UnTrans repr) =>
+	 Name -> repr f k -> repr f k
+	default rule ::
+	 Trans repr =>
+	 CLI_Help (UnTrans repr) =>
+	 Name -> repr f k -> repr f k
+	program n = noTrans . program n . unTrans
+	rule n = noTrans . rule n . unTrans
+infixr 0 `help`
+
+-- * Type 'Trans'
+class Trans repr where
+	-- | The @(repr)@esentation that @(repr)@ 'Trans'forms.
+	type UnTrans repr :: * -> * -> *
+	-- | Lift the underlying @(repr)@esentation to @(repr)@.
+	-- Useful to define a combinator that does nothing in a 'Trans'formation.
+	noTrans :: UnTrans repr a b -> repr a b
+	-- | Unlift a @(repr)@esentation. Useful when a 'Trans'formation
+	-- combinator needs to access the 'UnTrans'formed @(repr)@esentation,
+	-- or at the end to get the underlying 'UnTrans'formed @(repr)@esentation
+	-- from the inferred @(repr)@ value (eg. in 'server').
+	unTrans :: repr a b -> UnTrans repr a b
diff --git a/Symantic/CLI/Fixity.hs b/Symantic/CLI/Fixity.hs
new file mode 100644
--- /dev/null
+++ b/Symantic/CLI/Fixity.hs
@@ -0,0 +1,91 @@
+module Symantic.CLI.Fixity where
+
+import Data.Bool
+import Data.Eq (Eq(..))
+import Data.Function ((.))
+import Data.Int (Int)
+import Data.Maybe (Maybe(..))
+import Data.Ord (Ord(..))
+import Text.Show (Show(..))
+import qualified Data.Bool as Bool
+
+-- * Type 'Fixity'
+data Fixity
+ =   Fixity1 Unifix
+ |   Fixity2 Infix
+ deriving (Eq, Show)
+
+-- ** Type 'Unifix'
+data Unifix
+ =   Prefix  { unifix_prece :: Precedence }
+ |   Postfix { unifix_prece :: Precedence }
+ deriving (Eq, Show)
+
+-- ** Type 'Infix'
+data Infix
+ =   Infix
+ {   infix_assoc :: Maybe Associativity
+ ,   infix_prece :: Precedence
+ } deriving (Eq, Show)
+
+infixL :: Precedence -> Infix
+infixL = Infix (Just AssocL)
+
+infixR :: Precedence -> Infix
+infixR = Infix (Just AssocR)
+
+infixB :: Side -> Precedence -> Infix
+infixB = Infix . Just . AssocB
+
+infixN :: Precedence -> Infix
+infixN = Infix Nothing
+
+infixN0 :: Infix
+infixN0 = infixN 0
+
+infixN5 :: Infix
+infixN5 = infixN 5
+
+-- | Given 'Precedence' and 'Associativity' of its parent operator,
+-- and the operand 'Side' it is in,
+-- return whether an 'Infix' operator
+-- needs to be enclosed by parenthesis.
+needsParenInfix :: (Infix, Side) -> Infix -> Bool
+needsParenInfix (po, lr) op =
+	infix_prece op < infix_prece po
+	|| infix_prece op == infix_prece po
+	&& Bool.not associate
+	where
+	associate =
+		case (lr, infix_assoc po) of
+		 (_, Just AssocB{})   -> True
+		 (SideL, Just AssocL) -> True
+		 (SideR, Just AssocR) -> True
+		 _ -> False
+
+-- * Type 'Precedence'
+type Precedence = Int
+
+-- ** Class 'PrecedenceOf'
+class PrecedenceOf a where
+	precedence :: a -> Precedence
+instance PrecedenceOf Fixity where
+	precedence (Fixity1 uni) = precedence uni
+	precedence (Fixity2 inf) = precedence inf
+instance PrecedenceOf Unifix where
+	precedence = unifix_prece
+instance PrecedenceOf Infix where
+	precedence = infix_prece
+
+-- * Type 'Associativity'
+data Associativity
+ =   AssocL      -- ^ Associate to the left:  @a ¹ b ² c == (a ¹ b) ² c@
+ |   AssocR      -- ^ Associate to the right: @a ¹ b ² c == a ¹ (b ² c)@
+ |   AssocB Side -- ^ Associate to both sides, but to 'Side' when reading.
+ deriving (Eq, Show)
+
+-- ** Type 'Side'
+data Side
+ =   SideL -- ^ Left
+ |   SideR -- ^ Right
+ deriving (Eq, Show)
diff --git a/Symantic/CLI/Help.hs b/Symantic/CLI/Help.hs
new file mode 100644
--- /dev/null
+++ b/Symantic/CLI/Help.hs
@@ -0,0 +1,340 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-} -- for DocFrom (Word *) d
+module Symantic.CLI.Help where
+
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Foldable (null)
+import Data.Function (($), (.))
+import Data.Functor (Functor(..), (<$>))
+import Data.Maybe (Maybe(..), maybe, isJust)
+import Data.Monoid (Monoid(..))
+import Data.Semigroup (Semigroup(..))
+import Text.Show (Show(..))
+import Data.Tree as Tree
+import qualified Symantic.Document as Doc
+
+import Symantic.CLI.API
+import Symantic.CLI.Schema as Schema
+
+-- * Type 'Help'
+data Help d f k
+ =   Help
+ {   help_result :: HelpInh d -> HelpResult d
+     -- ^ The 'HelpResult' of the current symantic.
+ ,   help_schema :: Schema d f k
+     -- ^ The 'Schema' of the current symantic.
+ }
+
+runHelp :: Docable d => HelpInh d -> Help d f k -> d
+runHelp def (Help h _p) = runHelpNodes def (h def) <> Doc.newline
+
+docHelp :: Docable d => Doc.Indentable d => Docable d => Help d f k -> d
+docHelp = runHelp defHelpInh
+
+coerceHelp :: Help d f k -> Help d f' k'
+coerceHelp Help{help_schema, ..} = Help
+ { help_schema = Schema.coerceSchema help_schema
+ , ..
+ }
+
+-- ** Type 'HelpInh'
+-- | Configuration inherited top-down.
+data HelpInh d
+ =   HelpInh
+ {   helpInh_message :: !(Maybe d)
+     -- ^ The message inherited from 'help's.
+ ,   helpInh_command_indent :: !Doc.Indent
+     -- ^ 'Doc.Indent'ation for 'command's.
+ ,   helpInh_tag_indent :: !Doc.Indent
+     -- ^ 'Doc.Indent'ation for 'Tag's.
+ ,   helpInh_schema :: !(SchemaInh d)
+     -- ^ The inherited 'SchemaInh' for 'runSchema'.
+ ,   helpInh_helpless_options :: !Bool
+     -- ^ Whether to include options without help in the listing.
+ ,   helpInh_command_rule :: !Bool
+     -- ^ Whether to print the name of the rule.
+ ,   helpInh_full :: !Bool
+     -- ^ Whether to print full help.
+ }
+
+defHelpInh :: Docable d => HelpInh d
+defHelpInh = HelpInh
+ { helpInh_message          = Nothing
+ , helpInh_command_indent   = 2
+ , helpInh_tag_indent       = 16
+ , helpInh_schema           = defSchemaInh
+ , helpInh_helpless_options = False
+ , helpInh_command_rule     = False
+ , helpInh_full             = True
+ }
+
+-- ** Type 'HelpResult'
+type HelpResult d = Tree.Forest (HelpNode, d)
+
+defHelpResult :: Monoid d => HelpResult d
+defHelpResult = mempty
+
+-- *** Type 'HelpNode'
+data HelpNode
+ =   HelpNode_Message
+ |   HelpNode_Rule
+ |   HelpNode_Command
+ |   HelpNode_Tag
+ |   HelpNode_Env
+ deriving Show
+
+runHelpNode ::
+ Monoid d =>
+ Docable d =>
+ Tree (HelpNode, d) -> d
+runHelpNode (Tree.Node (n,d) _ts) = d -- "[" <> Doc.stringH (show n) <> "]" <> d
+
+-- | Introduce 'Doc.newline' according to the 'HelpNode's
+-- put next to each others.
+runHelpNodes ::
+ Monoid d =>
+ Docable d =>
+ HelpInh d ->
+ Tree.Forest (HelpNode, d) -> d
+runHelpNodes inh [] = mempty
+runHelpNodes inh ( t0@(Tree.Node (HelpNode_Command, _) t0s)
+                 : t1@(Tree.Node (HelpNode_Command, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	(if null t0s || not (helpInh_full inh) then mempty else Doc.newline) <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0@(Tree.Node (HelpNode_Tag, _) _)
+                 : t1@(Tree.Node (HelpNode_Tag, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0@(Tree.Node (HelpNode_Rule, _) t0s)
+                 : t1@(Tree.Node (HelpNode_Env, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	(if null t0s || not (helpInh_full inh) then mempty else Doc.newline) <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0@(Tree.Node (HelpNode_Env, _) _)
+                 : t1@(Tree.Node (HelpNode_Env, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0 : t1@(Tree.Node (HelpNode_Tag, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	Doc.newline <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0 : t1@(Tree.Node (HelpNode_Env, _) _) : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	Doc.newline <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh ( t0@(Tree.Node (HelpNode_Message, _) _)
+                 : t1 : ts ) =
+	runHelpNode t0 <>
+	Doc.newline <>
+	Doc.newline <>
+	runHelpNodes inh (t1:ts)
+runHelpNodes inh (t:ts) = runHelpNode t <> runHelpNodes inh ts
+
+instance Semigroup d => Semigroup (Help d f k) where
+	Help hx px <> Help hy py = Help (hx<>hy) (px<>py)
+instance Monoid d => Monoid (Help d f k) where
+	mempty  = Help mempty mempty
+	mappend = (<>)
+{-
+instance (Semigroup d, IsString d) => IsString (Help d e s a) where
+	fromString "" = Help $ \_ro -> Nothing
+	fromString s  = Help $ \_ro -> Just $ fromString s
+instance Show (Help Doc.Term e s a) where
+	show = TL.unpack . Doc.textTerm . runHelp
+instance Docable d => Functor (Help d f) where
+	f <$$> Help h s = Help h (f<$$>s)
+-}
+instance Docable d => App (Help d) where
+	Help hf pf <.> Help hx px = Help (hf<>hx) (pf<.>px)
+instance Docable d => Alt (Help d) where
+	Help hl pl <!> Help hr pr = Help (hl<>hr) (pl<!>pr)
+	opt (Help h s) = Help h (opt s)
+	{-
+	try (Help h s) = Help h (try s)
+	choice hs = Help (mconcat $ help_result <$> hs) (choice (help_schema <$> hs))
+	option a (Help h s) = Help h (option a s)
+	-}
+instance Docable d => Permutable (Help d) where
+	type Permutation (Help d) = HelpPerm d
+	runPermutation (HelpPerm h s) = Help h $ runPermutation s
+	toPermutation   (Help h s) = HelpPerm h $ toPermutation s
+	toPermDefault a (Help h s) = HelpPerm h $ toPermDefault a s
+instance Pro (Help d) where
+	dimap a2b b2a (Help h s) = Help h $ dimap a2b b2a s
+instance Docable d => AltApp (Help d) where
+	many0 (Help h s) = Help h (many0 s)
+	many1 (Help h s) = Help h (many1 s)
+instance Docable 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 Docable d => CLI_Env (Help d) where
+	type EnvConstraint (Help d) a = ()
+	env' n =
+		Help (\inh ->
+			let ts = maybe [] (pure . pure . (HelpNode_Message,)) (helpInh_message inh) in
+			let d =
+				Doc.breakfill (helpInh_tag_indent inh)
+				 (Doc.bold (Doc.green (Doc.docFrom (Doc.Word n)))
+					<> Doc.space)
+				<> (if null ts then mempty else Doc.space)
+				<> Doc.align (runHelpNodes inh ts)
+				in
+			[ Tree.Node (HelpNode_Env, d) ts ]
+		 ) schema
+		where schema = env' n
+instance Docable d => CLI_Command (Help d) where
+	-- type CommandConstraint (Help d) a = ()
+	command n (Help h s) =
+		Help (\inh ->
+			let ts =
+				(if helpInh_full inh
+				then maybe [] (pure . pure . (HelpNode_Message,)) (helpInh_message inh)
+				else []) <>
+				h inh
+				 { helpInh_message      = Nothing
+				 , helpInh_command_rule = True
+				 } in
+			let d =
+				(if not (null n) && helpInh_command_rule inh then ref<>Doc.space<>"::= " else mempty)
+				<> Schema.runSchema schema (helpInh_schema inh)
+				<> (if null ts || not (helpInh_full inh) then mempty else Doc.newline)
+				<> Doc.incrIndent (helpInh_command_indent inh)
+				 ((if null ts then mempty else Doc.newline) <> runHelpNodes inh ts)
+			in
+			[ Tree.Node (HelpNode_Command, d) ts ]
+		 ) schema
+		where
+		schema = command n s
+		ref =
+			Doc.bold $
+			Doc.angles $
+			Doc.magentaer $
+			Doc.docFrom (Doc.Word n)
+instance Docable d => CLI_Tag (Help d) where
+	type TagConstraint (Help d) a = ()
+	tagged n (Help h s) =
+		Help (\inh ->
+			if (isJust (helpInh_message inh)
+			|| helpInh_helpless_options inh)
+			&& helpInh_full inh
+			then
+				let ts =
+					maybe [] (pure . pure . (HelpNode_Message,)) (helpInh_message inh) <>
+					h inh{helpInh_message=Nothing} in
+				let d =
+					Doc.breakfill (helpInh_tag_indent inh)
+					 (Doc.bold $
+						Schema.runSchema schema (helpInh_schema inh)
+						<> Doc.space) -- FIXME: space is not always needed
+					<> (if null ts then mempty else Doc.space)
+					<> Doc.align (runHelpNodes inh ts)
+					in
+				[ Tree.Node (HelpNode_Tag, d) ts ]
+			else []
+		 ) schema
+		where schema = tagged n s
+	endOpts = Help mempty endOpts
+instance Docable d => CLI_Help (Help d) where
+	type HelpConstraint (Help d) d' = d ~ d'
+	help msg (Help h s) = Help
+	 (\inh -> h inh{helpInh_message=Just msg})
+	 (help msg s)
+	program n (Help h s) =
+		Help (\inh ->
+			let ts =
+				(if helpInh_full inh
+				then maybe [] (pure . pure . (HelpNode_Message,)) (helpInh_message inh)
+				else []) <>
+				h inh
+				 { helpInh_message      = Nothing
+				 , helpInh_command_rule = True
+				 } in
+			let d =
+				Schema.runSchema schema (helpInh_schema inh)
+				<> (if null ts {-|| not (helpInh_full inh)-} then mempty else Doc.newline)
+				<> Doc.incrIndent
+				 (helpInh_command_indent inh)
+				 ((if null ts then mempty else Doc.newline) <> runHelpNodes inh ts)
+			in
+			[ Tree.Node (HelpNode_Rule, d) ts ]
+		 ) schema
+		where
+		schema = program n s
+	rule n (Help h s) =
+		Help (\inh ->
+			let ts =
+				(if helpInh_full inh
+				then maybe [] (pure . pure . (HelpNode_Message,)) (helpInh_message inh)
+				else []) <>
+				h inh
+				 { helpInh_message      = Nothing
+				 , helpInh_command_rule = True
+				 } in
+			let d =
+				ref<>Doc.space<>"::= "
+				<> Schema.runSchema schema (helpInh_schema inh)
+				<> (if null ts || not (helpInh_full inh) then mempty else Doc.newline)
+				<> Doc.incrIndent
+				 (helpInh_command_indent inh)
+				 ((if null ts then mempty else Doc.newline) <> runHelpNodes inh ts)
+			in
+			[ Tree.Node (HelpNode_Rule, d) ts ]
+		 ) schema
+		where
+		schema = rule n s
+		ref =
+			Doc.bold $
+			Doc.angles $
+			Doc.magentaer $
+			Doc.docFrom (Doc.Word n)
+type HelpResponseArgs = SchemaResponseArgs
+instance Docable d => CLI_Response (Help d) where
+	type ResponseConstraint (Help d) a = () -- ResponseConstraint (Schema d)
+	type ResponseArgs (Help d) a = SchemaResponseArgs a -- ResponseArgs (Schema d) a
+	type Response (Help d) = () -- Response (Schema d)
+	response' ::
+	 forall a repr.
+	 repr ~ Help d =>
+	 ResponseConstraint repr a =>
+	 repr (ResponseArgs repr a)
+	      (Response repr)
+	response' = Help mempty $ response' @(Schema d) @a
+
+{-
+instance Docable d => Sym_AltApp (Help d) where
+	many (Help h s) = Help h (many s)
+	some (Help h s) = Help h (many s)
+-}
+
+-- * Type 'HelpPerm'
+data HelpPerm d k a
+ =   HelpPerm (HelpInh d -> HelpResult d)
+              (SchemaPerm d k a)
+instance Functor (HelpPerm d k) where
+	f`fmap`HelpPerm h ps = HelpPerm h (f<$>ps)
+instance Applicative (HelpPerm d k) where
+	pure a = HelpPerm mempty (pure a)
+	HelpPerm fh f <*> HelpPerm xh x =
+		HelpPerm (fh<>xh) (f<*>x)
+instance Docable d => CLI_Help (HelpPerm d) where
+	type HelpConstraint (HelpPerm d) d' = d ~ d'
+	help msg (HelpPerm h s) = HelpPerm
+	 (\inh -> h inh{helpInh_message=Just msg})
+	 (help msg s)
+	program n (HelpPerm h s) = HelpPerm
+	 (help_result $ program n (Help h (runPermutation s)))
+	 (rule n s)
+	rule n (HelpPerm h s) = HelpPerm
+	 (help_result $ rule n (Help h (runPermutation s)))
+	 (rule n s)
diff --git a/Symantic/CLI/Parser.hs b/Symantic/CLI/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Symantic/CLI/Parser.hs
@@ -0,0 +1,663 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+module Symantic.CLI.Parser where
+
+import Control.Applicative (Applicative(..), Alternative(..), optional, many, some)
+import Control.Arrow (first)
+import Control.Monad (Monad(..), join, sequence, unless)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Except (ExceptT(..),throwE,runExceptT)
+import Control.Monad.Trans.State (StateT(..),evalState,get,put)
+import Data.Bool
+import Data.Char (Char)
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), id, const)
+import Data.Functor (Functor(..), (<$>))
+import Data.Functor.Identity (Identity(..))
+import Data.Int (Int)
+import Data.Map.Strict (Map)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import System.Environment (lookupEnv)
+import System.IO (IO)
+import Text.Read (readEither)
+import Text.Show (Show(..), ShowS, showString, showParen)
+import Type.Reflection as Reflection
+import qualified Data.List as List
+import qualified Data.Text.Lazy.IO as TL
+import qualified Data.Text.Lazy.Builder as TLB
+import qualified Data.Map.Merge.Strict as Map
+import qualified Data.Map.Strict as Map
+import qualified Symantic.Document as Doc
+import qualified System.IO as IO
+-- import qualified Debug.Trace as Debug
+
+import Symantic.CLI.API
+
+-- * Type 'Parser'
+newtype Parser d f k = Parser
+ { unParser :: StateT ParserState
+               (ParserCheckT [ParserError] IO)
+               (f -> k) -- Reader f k
+ }
+instance Functor (Parser d f) where
+	a2b`fmap`Parser x = Parser $ (a2b <$>) <$> x
+instance Applicative (Parser d f) where
+	pure = Parser . pure . const
+	Parser f <*> Parser x = Parser $ (<*>) <$> f <*> x
+instance Alternative (Parser d f) where
+	empty = Parser $ do
+		StateT $ \st ->
+			throwE $ Fail st [ParserError_Alt]
+	Parser x <|> Parser y = Parser $
+		StateT $ \st -> do
+			lift (runExceptT (runStateT x st)) >>= \case
+			 Left xe | FailFatal{} <- xe -> throwE xe
+			         | otherwise ->
+				lift (runExceptT (runStateT y st)) >>= \case
+				 Left ye -> throwE (xe<>ye)
+				 Right yr -> ExceptT $ return $ Right yr
+			 Right xr ->
+				return xr
+instance Permutable (Parser d) where
+	type Permutation (Parser d) = ParserPerm d (Parser d)
+	runPermutation (ParserPerm ma p) = Parser $ do
+		u2p <- unParser $ optional p
+		unParser $
+			case u2p () of
+			 Nothing -> maybe empty (Parser . return) ma
+			 Just perm -> runPermutation perm
+	toPermutation (Parser x) =
+		ParserPerm Nothing
+		 (Parser $ (\a () -> ParserPerm (Just a) empty) <$> x)
+	toPermDefault a (Parser x) =
+		ParserPerm (Just ($ a))
+		 (Parser $ (\d () -> ParserPerm (Just d) empty) <$> x)
+
+parser ::
+ -- d ~ String => -- dummy d
+ Router (Parser d) handlers (Response (Router (Parser d))) ->
+ handlers ->
+ [Arg] -> IO ()
+parser api handlers args = do
+	lrApp <-
+		runExceptT $ runStateT
+		 (unParser $ unTrans $ router api)
+		 ParserState
+		 { parserState_args = args
+		 }
+	case lrApp of
+	 Left err -> IO.print err
+	 Right (app, _st) -> unResponseParser $ app handlers
+
+-- | Helper to parse the current argument.
+popArg ::
+ ParserError ->
+ (Arg ->
+  StateT ParserState (ParserCheckT [ParserError] IO) a) ->
+  StateT ParserState (ParserCheckT [ParserError] IO) a
+popArg errEnd f = do
+	st <- get
+	case parserState_args st of
+	 [] -> lift $ throwE $ Fail st [errEnd]
+	 curr:next -> do
+		lift (lift (runExceptT (runStateT (f curr) (ParserState next)))) >>= \case
+		 Left err -> lift $ throwE err
+		 Right (a,st') -> do
+			put st'
+			return a
+
+-- ** Type 'Arg'
+data Arg
+ =   ArgTagShort Char
+ |   ArgTagLong Name
+ |   ArgSegment Segment
+ deriving (Eq,Show)
+
+parseArgs :: [String] -> [Arg]
+parseArgs ss =
+	join $
+	(`evalState` False) $
+	sequence (f <$> ss)
+	where
+	f :: String -> StateT Bool Identity [Arg]
+	f s = do
+		skip <- get
+		if skip then return [ArgSegment s]
+		else case s of
+		 '-':'-':[] -> do
+			put True
+			return [ArgTagLong ""]
+		 '-':'-':cs -> return [ArgTagLong cs]
+		 '-':cs@(_:_) -> return $ ArgTagShort <$> cs
+		 seg -> return [ArgSegment seg]
+
+-- ** Type 'ParserState'
+newtype ParserState = ParserState
+ { parserState_args :: [Arg]
+ } deriving (Show)
+
+-- ** Type 'Router'
+type ParserCheckT e = ExceptT (Fail e)
+
+-- ** Type 'ParserError'
+data ParserError
+ =   ParserError_Alt -- ^ When there is no alternative.
+ |   ParserError_Arg { expectedArg :: Name,   gotArg :: Maybe Arg }
+ |   ParserError_Env { expectedEnv :: Name,   gotEnv :: Maybe String }
+ |   ParserError_Tag { expectedTag :: Tag,    gotArg :: Maybe Arg }
+ |   ParserError_Cmd { expectedCmd :: [Name], gotCmd :: Maybe Arg }
+ |   ParserError_Var { expectedVar :: Name,   gotVar :: Maybe Arg }
+ |   ParserError_End {                        gotEnd :: Arg }
+ deriving (Eq,Show)
+
+-- *** Type 'RouteResult'
+type RouteResult e = Either (Fail e)
+
+-- *** Type 'Fail'
+data Fail e
+ =   Fail ParserState e -- ^ Keep trying other paths.
+ |   FailFatal !ParserState !e -- ^ Don't try other paths.
+ deriving (Show)
+failState :: Fail e -> ParserState
+failState (Fail st _)      = st
+failState (FailFatal st _) = st
+failError :: Fail e -> e
+failError (Fail _st e)      = e
+failError (FailFatal _st e) = e
+instance Semigroup e => Semigroup (Fail e) where
+	Fail _ x      <> Fail st y      = Fail      st (x<>y)
+	FailFatal _ x <> Fail st _y     = FailFatal st (x{-<>y-})
+	Fail _ _x     <> FailFatal st y = FailFatal st ({-x<>-}y)
+	FailFatal _ x <> FailFatal st y = FailFatal st (x<>y)
+instance Monoid e => Monoid (Fail e) where
+	mempty = Fail (ParserState []) mempty
+	mappend = (<>)
+
+-- * Class 'FromSegment'
+class FromSegment a where
+	fromSegment :: Segment -> Either String a
+instance FromSegment String where
+	fromSegment = Right
+instance FromSegment Int where
+	fromSegment = readEither
+instance FromSegment Bool where
+	fromSegment = readEither
+
+-- ** Type 'ParserPerm'
+data ParserPerm d repr k a = ParserPerm
+ { permutation_result :: !(Maybe ((a->k)->k))
+ , permutation_parser :: repr () (ParserPerm d repr k a)
+ }
+
+instance (App repr, Functor (repr ())) => Functor (ParserPerm d repr k) where
+	a2b `fmap` ParserPerm a ma = ParserPerm
+	 ((\a2k2k b2k -> a2k2k $ b2k . a2b) <$> a)
+	 ((a2b `fmap`) `fmap` ma)
+instance (App repr, Functor (repr ()), Alternative (repr ())) => Applicative (ParserPerm d repr k) where
+	pure a = ParserPerm (Just ($ a)) empty
+	lhs@(ParserPerm f ma2b) <*> rhs@(ParserPerm x ma) =
+		ParserPerm a (lhsAlt <|> rhsAlt)
+		where
+		a =
+		 (\a2b2k2k a2k2k -> \b2k ->
+			a2b2k2k $ \a2b -> a2k2k (b2k . a2b)
+		 ) <$> f <*> x
+		lhsAlt = (<*> rhs) <$> ma2b
+		rhsAlt = (lhs <*>) <$> ma
+instance CLI_Help repr => CLI_Help (ParserPerm d repr) where
+	type HelpConstraint (ParserPerm d repr) d' = HelpConstraint (Parser d) d'
+	program _n = id
+	rule _n = id
+
+noTransParserPerm ::
+ Trans repr =>
+ Functor (UnTrans repr ()) =>
+ ParserPerm d (UnTrans repr) k a -> ParserPerm d repr k a
+noTransParserPerm (ParserPerm a ma) = ParserPerm a (noTrans $ noTransParserPerm <$> ma)
+
+unTransParserPerm ::
+ Trans repr =>
+ Functor (UnTrans repr ()) =>
+ ParserPerm d repr k a -> ParserPerm d (UnTrans repr) k a
+unTransParserPerm (ParserPerm a ma) = ParserPerm a (unTransParserPerm <$> unTrans ma)
+
+hoistParserPerm ::
+ Functor (repr ()) =>
+ (forall a b. repr a b -> repr a b) ->
+ ParserPerm d repr k c -> ParserPerm d repr k c
+hoistParserPerm f (ParserPerm a ma) =
+	ParserPerm a (hoistParserPerm f <$> f ma)
+
+instance App (Parser d) where
+	Parser x <.> Parser y = Parser $
+		x >>= \a2b -> (. a2b) <$> y
+instance Alt (Parser d) where
+	Parser x <!> Parser y = Parser $
+		StateT $ \st -> do
+			lift (runExceptT (runStateT x st)) >>= \case
+			 Left xe | FailFatal{} <- xe -> throwE xe
+			         | otherwise ->
+				lift (runExceptT (runStateT y st)) >>= \case
+				 Left ye -> throwE (xe<>ye)
+				 Right yr -> ExceptT $ return $ Right $
+					first (\b2k (_a:!:b) -> b2k b) yr
+			 Right xr ->
+				return $ first (\a2k (a:!:_b) -> a2k a) xr
+	opt (Parser x) = Parser $ do
+		st <- get
+		lift (lift (runExceptT $ runStateT x st)) >>= \case
+		 Left err -> return ($ Nothing)
+		 Right (a,st') -> do
+			put st'
+			return (mapCont Just a)
+instance AltApp (Parser d) where
+	many0 (Parser x) = Parser $ concatCont <$> many x
+	many1 (Parser x) = Parser $ concatCont <$> some x
+instance Pro (Parser d) where
+	dimap a2b _b2a (Parser r) = Parser $ (\k b2k -> k (b2k . a2b)) <$> r
+instance CLI_Command (Parser d) where
+	-- type CommandConstraint (Parser d) a = ()
+	command "" x = x
+	command n x = commands $ Map.singleton n x
+instance CLI_Var (Parser d) where
+	type VarConstraint (Parser d) a = FromSegment a
+	var' :: forall a k. VarConstraint (Parser d) a => Name -> Parser d (a->k) k
+	var' name = Parser $ do
+		popArg (ParserError_Var name Nothing) $ \curr -> do
+			st@ParserState{..} <- get
+			case curr of
+			 ArgSegment seg ->
+				case fromSegment seg of
+				 Left err -> lift $ throwE $ Fail st [ParserError_Var name (Just curr)]
+				 Right a -> return ($ a)
+			 _ -> lift $ throwE $ Fail st [ParserError_Var name (Just curr)]
+	just a  = Parser $ return ($ a)
+	nothing = Parser $ return id
+instance CLI_Env (Parser d) where
+	type EnvConstraint (Parser d) a = FromSegment a
+	env' :: forall a k. EnvConstraint (Parser d) a => Name -> Parser d (a->k) k
+	env' name = Parser $ do
+		st <- get
+		lift (lift (lookupEnv name)) >>= \case
+		 Nothing -> lift $ throwE $ Fail st [ParserError_Env name Nothing]
+		 Just raw ->
+				case fromSegment raw of
+				 Left err -> lift $ throwE $ Fail st [ParserError_Env name (Just raw)]
+				 Right a -> return ($ a)
+
+concatCont :: [(a->k)->k] -> ([a]->k)->k
+concatCont = List.foldr (consCont (:)) ($ [])
+
+consCont :: (a->b->c) -> ((a->k)->k) -> ((b->k)->k) -> (c->k)->k
+consCont ab2c a2k2k b2k2k = \c2k -> a2k2k $ \a -> b2k2k $ \b -> c2k (ab2c a b)
+
+mapCont :: (a->b) -> ((a->k)->k) -> ((b->k)->k)
+mapCont a2b a2k2k = \b2k -> a2k2k (b2k . a2b)
+
+instance CLI_Tag (Parser d) where
+	type TagConstraint (Parser d) a = ()
+	tagged name p = Parser $ do
+		popArg (ParserError_Tag name Nothing) $ \curr -> do
+			st <- get
+			case lookupTag curr name of
+			 False -> lift $ throwE $ Fail st [ParserError_Tag name (Just curr)]
+			 True ->
+				lift (lift (runExceptT (runStateT (unParser p) st))) >>= \case
+				 Left (Fail st' e) -> lift $ throwE $ FailFatal st' e
+				 Left e -> lift $ throwE e
+				 Right (a,st') -> do
+					put st'
+					return a
+		where
+		lookupTag (ArgTagShort x) (TagShort y) = x == y
+		lookupTag (ArgTagShort x) (Tag y _) = x == y
+		lookupTag (ArgTagLong x) (TagLong y) = x == y
+		lookupTag (ArgTagLong x) (Tag _ y) = x == y
+		lookupTag _ _ = False
+	endOpts = Parser $ do
+		popArg (ParserError_Tag (TagLong "") Nothing) $ \curr -> do
+			st@ParserState{..} <- get
+			case curr of
+			 ArgTagLong "" -> return id
+			 _ -> return id -- TODO: raise an error and use option?
+
+-- ** Type 'ParserResponse'
+newtype ParserResponse = ParserResponse { unResponseParser :: IO () }
+-- ** Type 'ParserResponseArgs'
+newtype ParserResponseArgs a = ParserResponseArgs (IO a)
+ deriving (Functor,Applicative,Monad)
+
+instance CLI_Response (Parser d) where
+	type ResponseConstraint (Parser d) a = Outputable a
+	type ResponseArgs (Parser d) a = ParserResponseArgs a
+	type Response (Parser d) = ParserResponse
+	response' = Parser $ do
+		st <- get
+		unless (List.null $ parserState_args st) $ do
+			lift $ throwE $ Fail st [ParserError_End $
+			 List.head $ parserState_args st]
+		return $ \(ParserResponseArgs io) ->
+			ParserResponse $ io >>= output
+
+-- * Class 'Outputable'
+-- | Output of a CLI.
+class IOType a => Outputable a where
+	output :: a -> IO ()
+	default output :: Show a => a -> IO ()
+	output = IO.print
+instance Outputable String where
+	output = IO.putStrLn
+
+instance Outputable (Doc.AnsiText (Doc.Plain TLB.Builder)) where
+	output =
+		TL.putStr .
+		TLB.toLazyText .
+		Doc.runPlain .
+		Doc.runAnsiText
+
+{-
+instance Outputable (Doc.Reorg Doc.Term) where
+	output = TL.hPutStrLn IO.stdout . Doc.textTerm
+instance Outputable (Doc.Reorg DocIO.TermIO) where
+	output = DocIO.runTermIO IO.stdout
+instance Outputable (IO.Handle, (Doc.Reorg DocIO.TermIO)) where
+	output = uncurry DocIO.runTermIO
+-}
+
+-- * Class 'IOType'
+-- | Like a MIME type but for input/output of a CLI.
+class IOType a where
+	ioType :: String
+	default ioType :: Reflection.Typeable a => String
+	ioType = show (Reflection.typeRep @a)
+
+instance IOType String
+instance IOType (Doc.AnsiText (Doc.Plain TLB.Builder))
+{-
+instance IOType (Doc.Reorg Doc.Term) where
+instance IOType (Doc.Reorg DocIO.TermIO) where
+instance IOType (IO.Handle, Doc.Reorg DocIO.TermIO)
+-}
+
+instance CLI_Help (Parser d) where
+	type HelpConstraint (Parser d) d' = d ~ d'
+	help _msg  = id
+	program _n = id
+	rule _n    = id
+
+
+-- ** Class 'CLI_Routing'
+class CLI_Routing repr where
+	commands :: Map Name (repr a k) -> repr a k
+	-- taggeds  :: TagConstraint repr a => Map (Either Char Name) (repr (a -> k) k) -> repr (a -> k) k
+instance CLI_Routing (Parser d) where
+	commands cmds = Parser $ do
+		st@ParserState{..} <- get
+		let exp = Map.keys cmds
+		popArg (ParserError_Cmd exp Nothing) $ \curr ->
+			case curr of
+			 ArgSegment cmd ->
+				case Map.lookup cmd cmds of
+				 Nothing -> lift $ throwE $ Fail st [ParserError_Cmd exp (Just curr)]
+				 Just x -> unParser x
+			 _ -> lift $ throwE $ Fail st [ParserError_Cmd exp (Just curr)]
+	{-
+	taggeds ms = Parser $ do
+		st@ParserState{..} <- get
+		case parserState_args of
+		 [] -> lift $ throwE $ Fail st [ParserError "empty path segment"]
+		 curr:next ->
+			case lookupTag curr of
+			 Nothing -> lift $ throwE $ Fail st [ParserError $ "expected: "<>fromString (show (Map.keys ms))<>" but got: "<>fromString (show curr)]
+			 Just x -> do
+				put st{parserState_args=next}
+				unParser x
+		where
+		lookupTag (ArgTagShort x) = Map.lookup (Left x) ms
+		lookupTag (ArgTagLong x) = Map.lookup (Right x) ms
+		lookupTag _ = Nothing
+	-}
+
+data Router repr a b where
+ -- | Lift any @(repr)@ into 'Router', those not useful to segregate
+ -- wrt. the 'Trans'formation performed, aka. 'noTrans'.
+ Router_Any :: repr a b -> Router repr a b
+ -- | Represent 'commands'.
+ Router_Commands :: Map Name (Router repr a k) -> Router repr a k
+ -- | Represent 'tagged'.
+ Router_Tagged :: Tag -> Router repr f k -> Router repr f k
+ -- | Represent 'taggeds'.
+ {-
+ Router_Taggeds :: TagConstraint repr a =>
+                  Map (Either Char Name) (Router repr (a -> k) k) ->
+                  Router repr (a -> k) k
+ -}
+ -- | Represent ('<.>').
+ Router_App :: Router repr a b -> Router repr b c -> Router repr a c
+ -- | Represent ('<!>').
+ Router_Alt :: Router repr a k -> Router repr b k -> Router repr (a:!:b) k
+ -- | Unify 'Router's which have different 'handlers'.
+ -- Useful to put alternative 'Router's in a 'Map' as in 'Router_Commands'.
+ Router_Union :: (b->a) -> Router repr a k -> Router repr b k
+
+instance Functor (Router (Parser d) f) where
+	a2b`fmap`x = noTrans (a2b <$> unTrans x)
+instance Applicative (Router (Parser d) f) where
+	pure = noTrans . pure
+	f <*> x = noTrans (unTrans f <*> unTrans x)
+instance Alternative (Router (Parser d) f) where
+	empty = noTrans empty
+	f <|> x = noTrans (unTrans f <|> unTrans x)
+instance Permutable (Router (Parser d)) where
+	type Permutation (Router (Parser d)) = ParserPerm d (Router (Parser d))
+	runPermutation  = noTrans . runPermutation . unTransParserPerm
+	toPermutation   = noTransParserPerm . toPermutation . unTrans
+	toPermDefault a = noTransParserPerm . toPermDefault a . unTrans
+instance (repr ~ Parser d) => Show (Router repr a b) where
+	showsPrec p = \case
+	 Router_Any{} -> showString "X"
+	 Router_Commands ms -> showParen (p>=10) $ showString "Commands [" . go (Map.toList ms) . showString "]"
+		where
+		go :: forall h k. [(Segment, Router repr h k)] -> ShowS
+		go [] = id
+		go ((n, r):xs) =
+			(showParen True $ showString (show n<>", ") . showsPrec 0 r) .
+			case xs of
+			 [] -> id
+			 _ -> showString ", " . go xs
+	 -- Router_Command n os x -> showString n . showString " " . showsPrec 10 (permutation_parser os) . showString " " . showsPrec p x
+	 Router_Tagged n x -> showsPrec 10 n . showString " " . showsPrec p x
+	 {-
+	 Router_Taggeds ms -> showParen (p>=10) $
+		showString "taggeds [" . go (Map.toList ms) . showString "]"
+		where
+		go :: forall h k. [(Either Char Name, Router repr h k)] -> ShowS
+		go [] = id
+		go ((n, r):xs) =
+			(showParen True $ showString (show n<>", ") . showsPrec 0 r) .
+			case xs of
+			 [] -> id
+			 _ -> showString ", " . go xs
+	 -}
+	 Router_App x y -> showParen (p>=4) $ showsPrec 4 x . showString " <.> " . showsPrec 4 y
+	 Router_Alt x y -> showParen (p>=3) $ showsPrec 3 x . showString " <!> " . showsPrec 3 y
+	 Router_Union _u x -> showString "Union [" . showsPrec 0 x . showString "]"
+
+instance Trans (Router (Parser d)) where
+	type UnTrans (Router (Parser d)) = Parser d
+	noTrans = Router_Any
+	unTrans (Router_Any x) = x
+	unTrans (Router_Alt x y) = unTrans x <!> unTrans y
+	unTrans (Router_App x y) = unTrans x <.> unTrans y
+	-- unTrans (Router_Command n os x) = command n (unTransParserPerm os) (unTrans x)
+	unTrans (Router_Commands ms) = commands (unTrans <$> ms)
+	unTrans (Router_Tagged n x) = tagged n (unTrans x)
+	-- unTrans (Router_Taggeds ms) = taggeds (unTrans <$> ms)
+	unTrans (Router_Union u x) = Parser $ (. u) <$> unParser (unTrans x)
+
+instance App (Router (Parser d)) where
+	(<.>) = Router_App
+instance Alt (Router (Parser d)) where
+	(<!>) = Router_Alt
+instance Pro (Router (Parser d))
+instance repr ~ (Parser d) => CLI_Command (Router repr) where
+	-- command = Router_Command
+	command "" x = x
+	command n x = Router_Commands $ Map.singleton n x
+instance CLI_Var (Router (Parser d))
+instance CLI_Env (Router (Parser d))
+instance CLI_Tag (Router (Parser d)) where
+	tagged = Router_Tagged
+instance CLI_Help (Router (Parser d)) where
+	-- NOTE: set manually (instead of the 'Trans' default 'Router_Any')
+	-- to remove them all, since they are useless for 'Parser'
+	-- and may prevent patterns to be matched in 'router'.
+	help _msg  = id
+	program _n = id
+	rule _n    = id
+instance CLI_Response (Router (Parser d))
+instance CLI_Routing (Router (Parser d)) where
+	-- taggeds  = Router_Taggeds
+	commands = Router_Commands
+
+router ::
+ repr ~ Parser d =>
+ Router repr a b -> Router repr a b
+router = {-debug1 "router" $-} \case
+ x@Router_Any{} -> x
+ -- Router_Command n os x -> Router_Command n (hoistParserPerm router os) (router x)
+ Router_Tagged n x -> Router_Tagged n (router x)
+ {-
+ Router_Tagged n x -> Router_Taggeds $
+	case n of
+	 Tag c s -> Map.fromList [(Left c, r), (Right s, r)]
+	 TagShort c -> Map.singleton (Left c) r
+	 TagLong s -> Map.singleton (Right s) r
+	 where r = router x
+ -}
+ {-
+ Router_Taggeds xs `Router_App` Router_Taggeds ys ->
+	Router_Taggeds $ router <$> (xs <> ys)
+ -}
+ Router_Alt x y -> router x`router_Alt`router y
+ Router_Commands xs -> Router_Commands $ router <$> xs
+ -- Router_Taggeds xs -> Router_Taggeds $ router <$> xs
+ Router_App xy z ->
+	case xy of
+	 Router_App x y ->
+		-- Associate to the right
+		Router_App (router x) $
+		Router_App (router y) (router z)
+	 _ -> router xy `Router_App` router z
+ Router_Union u x -> Router_Union u (router x)
+ -- Router_Merge x -> Router_Merge (router x)
+
+-- | Merge/reorder alternatives if possible or default to a 'Router_Alt'.
+router_Alt ::
+ repr ~ Parser d =>
+ Router repr a k ->
+ Router repr b k ->
+ Router repr (a:!:b) k
+router_Alt = {-debug2 "router_Alt"-} go
+	where
+	-- Merge alternative commands together.
+	{- NOTE: useless because 'command' is already a 'Router_Commands'.
+	go (Router_Command x xo xt) (Router_Command y yo yt) =
+		Map.singleton x (router (runPermutation xo <.> xt))
+		`router_Commands`
+		Map.singleton y (router (runPermutation yo <.> yt))
+	go (Router_Command x xo xt) (Router_Commands ys) =
+		Map.singleton x (router (runPermutation xo <.> xt))
+		`router_Commands` ys
+	go (Router_Commands xs) (Router_Command y yo yt) =
+		xs `router_Commands`
+		Map.singleton y (router (runPermutation yo <.> yt))
+	-}
+	go (Router_Commands xs) (Router_Commands ys) =
+		xs`router_Commands`ys
+	
+	-- Merge left first or right first, depending on which removes 'Router_Alt'.
+	go x (y`Router_Alt`z) =
+		case x`router_Alt`y of
+		 Router_Alt x' y' ->
+			case y'`router_Alt`z of
+			 yz@(Router_Alt _y z') ->
+				case x'`router_Alt`z' of
+				 Router_Alt{} -> router x'`Router_Alt`yz
+				 xz -> Router_Union (\(a:!:(b:!:c)) -> (a:!:c):!:b) $ xz`router_Alt`y
+					-- NOTE: prioritize the merged router 'xz' over over the non-mergeable 'y'.
+			 yz -> x'`router_Alt`yz
+		 xy -> Router_Union (\(a:!:(b:!:c)) -> (a:!:b):!:c) $ xy`router_Alt`z
+	go (x`Router_Alt`y) z =
+		case y`router_Alt`z of
+		 Router_Alt y' z' ->
+			case x`router_Alt`y' of
+			 xy@(Router_Alt x' _y) ->
+				case x'`router_Alt`z' of
+				 Router_Alt{} -> xy`Router_Alt`router z'
+				 xz -> Router_Union (\((a:!:b):!:c) -> (a:!:c):!:b) $ xz`router_Alt`y
+					-- NOTE: prioritize the merged router 'xz' over the non-mergeable 'y'.
+			 xy -> xy`router_Alt`z'
+		 yz -> Router_Union (\((a:!:b):!:c) -> a:!:(b:!:c)) $ x`router_Alt`yz
+	
+	-- Merge through 'Router_Union'.
+	go (Router_Union u x) y = Router_Union (\(a:!:b) -> u a:!:b) (x`router_Alt`y)
+	go x (Router_Union u y) = Router_Union (\(a:!:b) -> a:!:u b) (x`router_Alt`y)
+	
+	-- No merging
+	go x y = x`Router_Alt`y
+
+router_Commands ::
+ repr ~ Parser d =>
+ Map Segment (Router repr a k) ->
+ Map Segment (Router repr b k) ->
+ Router repr (a:!:b) k
+router_Commands xs ys =
+	-- NOTE: a little bit more complex than required
+	-- in order to merge 'Router_Union's instead of nesting them,
+	-- such that 'unTrans' 'Router_Union' applies them all at once.
+	Router_Commands $
+	Map.merge
+	 (Map.traverseMissing $ const $ \case
+		 Router_Union u r ->
+			return $ Router_Union (\(x:!:_y) -> u x) r
+		 r -> return $ Router_Union (\(x:!:_y) -> x) r)
+	 (Map.traverseMissing $ const $ \case
+		 Router_Union u r ->
+			return $ Router_Union (\(_x:!:y) -> u y) r
+		 r -> return $ Router_Union (\(_x:!:y) -> y) r)
+	 (Map.zipWithAMatched $ const $ \case
+		 Router_Union xu xr -> \case
+			 Router_Union yu yr ->
+				return $ Router_Union (\(x:!:y) -> xu x:!:yu y) $ xr`router_Alt`yr
+			 yr ->
+				return $ Router_Union (\(a:!:b) -> xu a:!:b) $ xr`router_Alt`yr
+		 xr -> \case
+			 Router_Union yu yr ->
+				return $ Router_Union (\(a:!:b) -> a:!:yu b) $ xr`router_Alt`yr
+			 yr -> return $ xr`router_Alt`yr)
+	 xs ys
+
+{-
+debug0 :: Show a => String -> a -> a
+debug0 n a = Debug.trace (" {"<>n<>": "<>show a) a
+debug1 :: Show a => Show b => String -> (a->b) -> (a->b)
+debug1 n a2b a = Debug.trace ("} "<>n<>": r: "<>show b) b
+	where b = a2b $ Debug.trace ("{ "<>n<>": a: "<>show a) a
+debug2 :: Show a => Show b => Show c => String -> (a->b->c) -> (a->b->c)
+debug2 n a2b2c a b = Debug.trace ("} "<>n<>": r: "<>show c) c
+	where
+	b2c = a2b2c $ Debug.trace ("{ "<>n<>": a: "<>show a) a
+	c   = b2c   $ Debug.trace (n<>": b: "<>show b) b
+-}
diff --git a/Symantic/CLI/Schema.hs b/Symantic/CLI/Schema.hs
new file mode 100644
--- /dev/null
+++ b/Symantic/CLI/Schema.hs
@@ -0,0 +1,273 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-} -- for DocFrom (Word *) d
+module Symantic.CLI.Schema where
+
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Char (Char)
+import Data.Function (($), (.), id)
+import Data.Functor (Functor(..), (<$>))
+import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
+import Data.Monoid (Monoid(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String, IsString(..))
+import Data.Text (Text)
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TLB
+import qualified Symantic.Document as Doc
+
+import Symantic.CLI.API
+import Symantic.CLI.Fixity
+
+-- * Type 'Schema'
+newtype Schema d f k
+ =      Schema { unSchema :: SchemaInh d -> Maybe d }
+
+runSchema :: Monoid d => Schema d f k -> SchemaInh d -> d
+runSchema (Schema s) = fromMaybe mempty . s
+
+docSchema :: Monoid d => Docable d => Schema d f k -> d
+docSchema s = runSchema s defSchemaInh
+
+coerceSchema :: Schema d f k -> Schema d f' k'
+coerceSchema Schema{..} = Schema{..}
+
+-- ** Type 'Doc'
+type Doc = Doc.AnsiText (Doc.Plain TLB.Builder)
+
+-- ** Class 'Docable'
+type Docable d =
+ ( Semigroup d
+ , Monoid d
+ , IsString d
+ , Doc.Colorable16 d
+ , Doc.Decorable d
+ , Doc.Spaceable d
+ , Doc.Indentable d
+ , Doc.Wrappable d
+ , Doc.DocFrom (Doc.Word Char) d
+ , Doc.DocFrom (Doc.Word Text) d
+ , Doc.DocFrom (Doc.Word String) d
+ )
+
+-- ** Type 'SchemaInh'
+-- | Inherited top-down.
+data SchemaInh d
+ =   SchemaInh
+ {   schemaInh_op     :: (Infix, Side) -- ^ Parent operator.
+ ,   schemaInh_define :: Bool          -- ^ Whether to print a definition, or not.
+ ,   schemaInh_or     :: d
+ }
+
+defSchemaInh :: Docable d => SchemaInh d
+defSchemaInh = SchemaInh
+ { schemaInh_op     = (infixN0, SideL)
+ , schemaInh_define = True
+ , schemaInh_or     = docOrH
+ }
+
+pairIfNeeded :: Docable d => SchemaInh d -> Infix -> d -> d
+pairIfNeeded SchemaInh{..} op =
+	if needsParenInfix schemaInh_op op
+	then Doc.align . Doc.parens
+	else id
+
+instance Semigroup d => Semigroup (Schema d f k) where
+	Schema x <> Schema y = Schema $ x <> y
+instance (Semigroup d, Monoid d) => Monoid (Schema d f k) where
+	mempty  = Schema mempty
+	mappend = (<>)
+instance (Semigroup d, IsString d) => IsString (Schema d f k) where
+	fromString "" = Schema $ \_inh -> Nothing
+	fromString s  = Schema $ \_inh -> Just $ fromString s
+instance Show (Schema Doc a k) where
+	show =
+		TL.unpack .
+		TLB.toLazyText .
+		Doc.runPlain .
+		Doc.runAnsiText .
+		docSchema
+
+docOrH, docOrV :: Doc.Spaceable d => Doc.DocFrom (Doc.Word Char) d => d
+docOrH = Doc.space <> Doc.docFrom (Doc.Word '|') <> Doc.space
+docOrV = Doc.newline <> Doc.docFrom (Doc.Word '|') <> Doc.space
+
+{-
+instance Docable d => Functor (Schema d f) where
+	_f `fmap` Schema x = Schema $ \inh ->
+		pairIfNeeded inh op <$>
+		x inh{schemaInh_op=(op, SideR)}
+		where
+		op = infixB SideL 10
+-}
+instance Docable d => App (Schema d) where
+	Schema f <.> Schema x = Schema $ \inh ->
+		case (f inh{schemaInh_op=(op, SideL)}, x inh{schemaInh_op=(op, SideR)}) of
+		 (Nothing, Nothing) -> Nothing
+		 (Just f', Nothing) -> Just f'
+		 (Nothing, Just x') -> Just x'
+		 (Just f', Just x') -> Just $ pairIfNeeded inh op $ f' <> Doc.space <> x'
+		where
+		op = infixB SideL 10
+instance Docable d => Alt (Schema d) where
+	lp <!> rp = Schema $ \inh ->
+		case (unSchema lp inh, unSchema rp inh) of
+		 (Nothing, Nothing) -> Nothing
+		 (Just lp', Nothing) -> Just lp'
+		 (Nothing, Just rp') -> Just rp'
+		 (Just{}, Just{}) -> Just $
+			if needsParenInfix (schemaInh_op inh) op
+			then
+				Doc.breakalt
+				 (Doc.parens $
+					-- Doc.withBreakable Nothing $
+					runSchema lp inh
+					 { schemaInh_op=(op, SideL)
+					 , schemaInh_or=docOrH } <>
+					docOrH <>
+					runSchema rp inh
+					 { schemaInh_op=(op, SideR)
+					 , schemaInh_or=docOrH })
+				 (Doc.align $
+					Doc.parens $
+					Doc.space <>
+					runSchema lp inh
+					 { schemaInh_op=(op, SideL)
+					 , schemaInh_or=docOrV } <>
+					docOrV <>
+					runSchema rp inh
+					 { schemaInh_op=(op, SideR)
+					 , schemaInh_or=docOrV } <>
+					Doc.newline)
+			else
+				runSchema lp inh{schemaInh_op=(op, SideL)} <>
+				schemaInh_or inh <>
+				runSchema rp inh{schemaInh_op=(op, SideR)}
+		where op = infixB SideL 2
+	opt s = Schema $ \inh -> Just $
+		Doc.brackets $
+		runSchema s inh{schemaInh_op=(op, SideL)}
+		where op = infixN0
+instance Pro (Schema d) where
+	dimap _a2b _b2a = coerceSchema
+instance Docable d => AltApp (Schema d) where
+	many0 s = Schema $ \inh -> Just $
+		runSchema s inh{schemaInh_op=(op, SideL)}<>"*"
+		where op = infixN 10
+	many1 s = Schema $ \inh -> Just $
+		runSchema s inh{schemaInh_op=(op, SideL)}<>"..."
+		where op = infixN 10
+instance Docable d => CLI_Command (Schema d) where
+	-- type CommandConstraint (Schema d) a = ()
+	command n s = Schema $ \inh -> Just $
+		if schemaInh_define inh || List.null n
+		then
+			runSchema
+			 (fromString n <.> coerceSchema s)
+			 inh{schemaInh_define = False}
+		else ref
+		where
+		ref =
+			Doc.bold $
+			Doc.angles $
+			Doc.magentaer $
+			Doc.docFrom (Doc.Word n)
+instance Docable d => CLI_Var (Schema d) where
+	type VarConstraint (Schema d) a = ()
+	var' n = Schema $ \_inh -> Just $
+		Doc.underline $ Doc.docFrom $ Doc.Word n
+	just _  = Schema $ \_inh -> Nothing
+	nothing = Schema $ \_inh -> Nothing
+instance Docable d => CLI_Env (Schema d) where
+	type EnvConstraint (Schema d) a = ()
+	env' n = Schema $ \_inh -> Nothing
+	 -- NOTE: environment variables are not shown in the schema,
+	 -- only in the help.
+instance Docable d => CLI_Tag (Schema d) where
+	type TagConstraint (Schema d) a = ()
+	tagged n r = Schema $ \inh ->
+		unSchema (prefix n <.> r) inh
+		where
+		prefix = \case
+		 Tag      s l -> prefix (TagShort s)<>"|"<>prefix (TagLong l)
+		 TagShort s   -> fromString ['-', s]
+		 TagLong  l   -> fromString ("--"<>l)
+	endOpts = Schema $ \_inh -> Just $ Doc.brackets "--"
+instance Docable d => CLI_Help (Schema d) where
+	type HelpConstraint (Schema d) d' = d ~ d'
+	help _msg = id
+	program n s = Schema $ \inh -> Just $
+		runSchema
+		 (fromString n <.> coerceSchema s)
+		 inh{schemaInh_define = False}
+	rule n s = Schema $ \inh -> Just $
+		if schemaInh_define inh
+		then runSchema s inh{schemaInh_define=False}
+		else ref
+		where
+		ref =
+			Doc.bold $
+			Doc.angles $
+			Doc.magentaer $
+			Doc.docFrom (Doc.Word n)
+data SchemaResponseArgs a
+instance Docable d => CLI_Response (Schema d) where
+	type ResponseConstraint (Schema d) a = ()
+	type ResponseArgs (Schema d) a = SchemaResponseArgs a
+	type Response (Schema d) = ()
+	response' = Schema $ \_inh -> Nothing
+
+-- ** Type 'SchemaPerm'
+data SchemaPerm d k a = SchemaPerm
+ { schemaPerm_finalizer    :: forall b c. Schema d (b->c) c -> Schema d (b->c) c
+   -- ^ Used to implement 'rule'.
+ , schemaPerm_alternatives :: [Schema d (a->k) k]
+   -- ^ Collect alternatives for rendering them all at once in 'runPermutation'.
+ }
+instance Functor (SchemaPerm d k) where
+	_f`fmap`SchemaPerm w ps = SchemaPerm w (coerceSchema <$> ps)
+instance Applicative (SchemaPerm d k) where
+	pure _a = SchemaPerm id mempty
+	SchemaPerm fd w <*> SchemaPerm fx x =
+		SchemaPerm (fd . fx) $ (coerceSchema <$> w) <> (coerceSchema <$> x)
+instance Docable d => Permutable (Schema d) where
+	type Permutation (Schema d) = SchemaPerm d
+	runPermutation (SchemaPerm w ps) =
+		case ps of
+		 [] -> w $ Schema $ \_inh -> Nothing
+		 [Schema s] -> w $ Schema s
+		 _ -> w $ Schema $ \inh -> Just $
+			-- pairIfNeeded inh op $
+			Doc.align $
+			Doc.intercalate Doc.breakspace $
+			catMaybes $ (<$> ps) $ \(Schema s) ->
+				s inh
+				 { schemaInh_op=(op, SideL)
+				 , schemaInh_or=docOrH }
+			where op = infixN 10
+	toPermutation = SchemaPerm id . pure
+	toPermDefault a s = SchemaPerm id $ pure $ Schema $ \inh -> Just $
+		if needsParenInfix (schemaInh_op inh) op
+		then
+			Doc.breakalt
+			 (Doc.brackets $
+				-- Doc.withBreakable Nothing $
+				runSchema s inh{schemaInh_op=(op, SideL), schemaInh_or=docOrH})
+			 (Doc.align $
+				Doc.brackets $
+				Doc.space <>
+				runSchema s inh{schemaInh_op=(op, SideL)} <>
+				Doc.newline)
+		else
+			runSchema s inh{schemaInh_op=(op, SideL)}
+		where op = infixN0
+instance Docable d => CLI_Help (SchemaPerm d) where
+	type HelpConstraint (SchemaPerm d) d' = d ~ d'
+	help _msg = id
+	program n (SchemaPerm w ps) = SchemaPerm (program n . w) ps
+	rule n (SchemaPerm w ps) = SchemaPerm (rule n . w) ps
diff --git a/stack.yaml b/stack.yaml
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,6 +1,6 @@
-resolver: lts-12.8
+resolver: lts-13.19
 packages:
 - '.'
 - location: '../symantic-document'
   extra-dep: true
-
+extra-deps:
diff --git a/symantic-cli.cabal b/symantic-cli.cabal
--- a/symantic-cli.cabal
+++ b/symantic-cli.cabal
@@ -2,10 +2,14 @@
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.0.0.20180410
-category: Data Structures
-synopsis: Library for Command Line Interface (CLI)
-description: Symantics for CLI.
+version: 2.0.0.20190615
+category: 
+synopsis: Symantics for parsing and documenting a CLI
+description:
+  An extensible, typed and embedded Domain-Specific Language (DSL)
+  to build Command Line Interface (CLI)
+  using a write-an-API-then-derive-code-from-it approach.
+  The derivations currently implemented are for parsing arguments or printing help.
 extra-doc-files:
 license: GPL-3
 license-file: COPYING
@@ -16,24 +20,23 @@
 -- homepage:
 
 build-type: Simple
-cabal-version: >= 1.18
-tested-with: GHC==8.4.3
+cabal-version: 1.24
+tested-with: GHC==8.6.4
 extra-source-files:
   stack.yaml
 extra-tmp-files:
 
 Source-Repository head
-  location: git://git.autogeree.net/symantic
+  location: git://git.autogeree.net/symantic-cli
   type:     git
 
 Library
   exposed-modules:
-    Language.Symantic.CLI
-    Language.Symantic.CLI.Fixity
-    Language.Symantic.CLI.Help
-    Language.Symantic.CLI.Plain
-    Language.Symantic.CLI.Read
-    Language.Symantic.CLI.Sym
+    Symantic.CLI.API
+    Symantic.CLI.Fixity
+    Symantic.CLI.Help
+    Symantic.CLI.Parser
+    Symantic.CLI.Schema
   default-language: Haskell2010
   default-extensions:
     FlexibleContexts
@@ -45,7 +48,9 @@
     RecordWildCards
     ScopedTypeVariables
     TupleSections
+    TypeApplications
     TypeFamilies
+    TypeOperators
   ghc-options:
     -Wall
     -Wincomplete-uni-patterns
@@ -53,9 +58,8 @@
     -fno-warn-tabs
     -- -fhide-source-paths
   build-depends:
-      base         >= 4.10 && < 5
-    , containers   >= 0.5
-    , text         >= 1.2
-    , transformers >= 0.5
-    , megaparsec   >= 6.3
-    , symantic-document
+      base              >= 4.10 && < 5
+    , containers        >= 0.5
+    , symantic-document >= 0.2
+    , text              >= 1.2
+    , transformers      >= 0.5