From fcddf04fe83d77a9a67c502db50838fa04b261e0 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Fri, 18 Aug 2017 22:21:21 +0200
Subject: [PATCH 01/16] Bump versions.

---
 symantic-grammar/symantic-grammar.cabal | 2 +-
 symantic-lib/symantic-lib.cabal         | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/symantic-grammar/symantic-grammar.cabal b/symantic-grammar/symantic-grammar.cabal
index 09b3376..edb7c63 100644
--- a/symantic-grammar/symantic-grammar.cabal
+++ b/symantic-grammar/symantic-grammar.cabal
@@ -22,7 +22,7 @@ tested-with: GHC==8.0.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.2.0.20170709
+version: 0.2.1.20170818
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
diff --git a/symantic-lib/symantic-lib.cabal b/symantic-lib/symantic-lib.cabal
index 7e0c484..86563a6 100644
--- a/symantic-lib/symantic-lib.cabal
+++ b/symantic-lib/symantic-lib.cabal
@@ -19,7 +19,7 @@ tested-with: GHC==8.0.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.0.2.20170703
+version: 0.0.2.20170818
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
-- 
2.44.1


From 4ae53f12d6e52ce1544f54210d311f829216dfda Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Sat, 19 Aug 2017 17:40:39 +0200
Subject: [PATCH 02/16] Add infix operators to HLint.

---
 HLint.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/HLint.hs b/HLint.hs
index 1882a9d..0ebb5b3 100644
--- a/HLint.hs
+++ b/HLint.hs
@@ -8,5 +8,7 @@ ignore "Use fmap"
 -- BEGIN: generated hints
 infixl 5 `ebnf_arg`
 infixl 5 `setSource`
+infixl 9 :@
+infixr 0 :$
 infixr 5 `VarS`
 -- END: generated hints
-- 
2.44.1


From 5d944a1cd108ecf0647696bf6e3ac9f7e2f04bf3 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 13 Feb 2018 05:38:24 +0100
Subject: [PATCH 03/16] Sync with ghc-8.2.2 and megaparsec-6.3.0.

---
 GNUmakefile                                   |  4 +-
 HLint.hs                                      |  5 --
 symantic-document/stack.yaml                  |  2 +-
 .../Language/Symantic/Grammar/ContextFree.hs  |  9 ++--
 .../Language/Symantic/Grammar/EBNF.hs         |  3 +-
 .../Language/Symantic/Grammar/Fixity.hs       |  3 +-
 .../Language/Symantic/Grammar/Operators.hs    |  6 +--
 .../Language/Symantic/Grammar/Regular.hs      |  2 +-
 .../Language/Symantic/Grammar/Terminal.hs     | 54 +++++++++++--------
 .../Language/Symantic/Grammar/Test.hs         | 39 +++++++-------
 symantic-grammar/stack.yaml                   |  2 +-
 symantic-grammar/symantic-grammar.cabal       |  2 +-
 .../Language/Symantic/Compiling/Test.hs       |  7 +--
 .../Language/Symantic/Grammar/Megaparsec.hs   | 40 +++++++++-----
 .../Language/Symantic/Lib/Alternative.hs      |  2 +-
 .../Language/Symantic/Lib/Applicative.hs      |  2 +-
 .../Language/Symantic/Lib/Applicative/Test.hs |  1 -
 symantic-lib/Language/Symantic/Lib/Char.hs    |  4 +-
 .../Language/Symantic/Lib/Foldable.hs         |  2 +-
 .../Language/Symantic/Lib/Foldable/Test.hs    |  1 -
 .../Language/Symantic/Lib/Functor/Test.hs     |  1 -
 .../Language/Symantic/Lib/Map/Test.hs         |  1 -
 .../Language/Symantic/Lib/MonoFunctor/Test.hs |  1 -
 symantic-lib/Language/Symantic/Lib/Test.hs    |  2 +-
 symantic-lib/Language/Symantic/Lib/Text.hs    |  2 +-
 .../Language/Symantic/Lib/Tuple2/Test.hs      |  1 -
 symantic-lib/Language/Symantic/Lib/Unit.hs    |  2 -
 symantic-lib/Language/Symantic/Typing/Test.hs | 11 ++--
 symantic-lib/stack.yaml                       |  5 +-
 symantic/Language/Symantic/Compiling/Beta.hs  | 16 +++---
 .../Language/Symantic/Compiling/Grammar.hs    | 10 ++--
 .../Language/Symantic/Compiling/Module.hs     |  3 +-
 symantic/Language/Symantic/Compiling/Term.hs  |  2 +-
 .../Language/Symantic/Interpreting/View.hs    |  4 +-
 symantic/Language/Symantic/Typing/Document.hs |  5 +-
 symantic/Language/Symantic/Typing/Grammar.hs  |  7 ++-
 symantic/Language/Symantic/Typing/Peano.hs    |  1 -
 symantic/Language/Symantic/Typing/Type.hs     |  2 +-
 symantic/Language/Symantic/Typing/Unify.hs    |  2 +-
 symantic/Language/Symantic/Typing/Variable.hs |  7 +--
 symantic/README.md                            |  2 +-
 symantic/stack.yaml                           |  2 +-
 symantic/symantic.cabal                       | 12 +++--
 43 files changed, 152 insertions(+), 139 deletions(-)

diff --git a/GNUmakefile b/GNUmakefile
index b29029b..36d2a33 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,5 +1,5 @@
 PKGS := symantic-grammar symantic-document symantic symantic-lib
-HS := $(shell find $(PKGS) -name '*.hs')
+HS := $(shell find $(PKGS) -name '*.hs' -not -name 'HLint.hs')
 
 all: build
 
@@ -45,7 +45,7 @@ lint: $(PKGS:=/lint) $(HS)
 	cd $*; if hlint --quiet --report=hlint.html -XNoCPP \
 	 $(shell cabal-cargs --format=ghc --only=default_extensions --sourcefile=$*) $(HLINT_FLAGS) .; \
 	then rm -f hlint.html; \
-	else sensible-browser hlint.html & fi
+	else sensible-browser ./hlint.html & fi
 
 tag: $(PKGS:=/tag)
 %/tag:
diff --git a/HLint.hs b/HLint.hs
index 0ebb5b3..e1ae96d 100644
--- a/HLint.hs
+++ b/HLint.hs
@@ -6,9 +6,4 @@ ignore "Use import/export shortcut"
 ignore "Use fmap"
 
 -- BEGIN: generated hints
-infixl 5 `ebnf_arg`
-infixl 5 `setSource`
-infixl 9 :@
-infixr 0 :$
-infixr 5 `VarS`
 -- END: generated hints
diff --git a/symantic-document/stack.yaml b/symantic-document/stack.yaml
index 5bbd150..1adfccd 100644
--- a/symantic-document/stack.yaml
+++ b/symantic-document/stack.yaml
@@ -1,3 +1,3 @@
-resolver: lts-9.0
+resolver: lts-10.5
 packages:
 - '.'
diff --git a/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs b/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
index 9f67fd5..cde5c6a 100644
--- a/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
@@ -17,7 +17,7 @@ import Language.Symantic.Grammar.Regular
 -- * Type 'CF'
 -- | Context-free grammar.
 newtype CF g a = CF { unCF :: g a }
- deriving (IsString, Functor, Gram_Terminal, Applicative, Gram_App)
+ deriving (IsString, Functor, Gram_Char, Gram_String, Applicative, Gram_App)
 deriving instance Gram_Error err g => Gram_Error err (CF g)
 deriving instance Gram_Reader st g => Gram_Reader st (CF g)
 deriving instance Gram_State st g => Gram_State st (CF g)
@@ -111,7 +111,8 @@ instance Gram_AltApp EBNF where
 -- * Class 'Gram_Comment'
 -- | Symantics for handling comments after each 'lexeme'.
 class
- ( Gram_Terminal g
+ ( Gram_Char g
+ , Gram_String g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_App g
@@ -119,8 +120,8 @@ class
  , Gram_CF g
  ) => Gram_Comment g where
 	commentable :: g () -> g () -> g () -> g ()
-	commentable = rule3 "Commentable" $ \space line block ->
-		manySkip $ choice [space, line, block]
+	commentable = rule3 "Commentable" $ \sp line block ->
+		manySkip $ choice [sp, line, block]
 	commentLine :: CF g String -> CF g String
 	commentLine prefix = rule "CommentLine" $
 		prefix *> many (any `minus` (void eol <+> eoi))
diff --git a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
index 50cb2c8..63d040f 100644
--- a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
@@ -2,9 +2,8 @@ module Language.Symantic.Grammar.EBNF where
 
 import Control.Applicative (Applicative(..))
 import Control.Monad
-import Data.Semigroup hiding (option)
+import Data.Semigroup
 import Data.Text (Text)
-import Prelude hiding (any)
 import qualified Data.Text as Text
 
 import Language.Symantic.Grammar.Meta
diff --git a/symantic-grammar/Language/Symantic/Grammar/Fixity.hs b/symantic-grammar/Language/Symantic/Grammar/Fixity.hs
index d11c163..27645a3 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Fixity.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Fixity.hs
@@ -1,9 +1,8 @@
 module Language.Symantic.Grammar.Fixity where
 
 import Data.Bool as Bool
-import Data.Semigroup hiding (option)
+import Data.Semigroup
 import Data.String (IsString(..))
-import Prelude hiding (any)
 
 -- * Type 'Fixity'
 data Fixity
diff --git a/symantic-grammar/Language/Symantic/Grammar/Operators.hs b/symantic-grammar/Language/Symantic/Grammar/Operators.hs
index f8369d3..7c70819 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Operators.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Operators.hs
@@ -4,8 +4,7 @@ module Language.Symantic.Grammar.Operators where
 
 import Control.Applicative (Applicative(..))
 import Control.Monad (void)
-import Data.Foldable hiding (any)
-import Prelude hiding (any)
+import Data.Foldable
 
 import Language.Symantic.Grammar.Fixity
 import Language.Symantic.Grammar.EBNF
@@ -16,7 +15,8 @@ import Language.Symantic.Grammar.ContextFree
 -- * Class 'Gram_Op'
 -- | Symantics for operators.
 class
- ( Gram_Terminal g
+ ( Gram_Char g
+ , Gram_String g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_Try g
diff --git a/symantic-grammar/Language/Symantic/Grammar/Regular.hs b/symantic-grammar/Language/Symantic/Grammar/Regular.hs
index cf37c0c..cd8def7 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Regular.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Regular.hs
@@ -13,7 +13,7 @@ import Language.Symantic.Grammar.Terminal
 -- * Type 'Reg'
 -- | Left or right regular grammar.
 newtype Reg (lr::Side) g a = Reg { unReg :: g a }
- deriving (IsString, Functor, Gram_Terminal)
+ deriving (IsString, Functor, Gram_Char, Gram_String)
 deriving instance Gram_Alt g => Gram_Alt (Reg lr g)
 deriving instance Gram_Try g => Gram_Try (Reg lr g)
 deriving instance Gram_Rule g => Gram_Rule (Reg lr g)
diff --git a/symantic-grammar/Language/Symantic/Grammar/Terminal.hs b/symantic-grammar/Language/Symantic/Grammar/Terminal.hs
index 5c6fa61..b5ad4b9 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Terminal.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Terminal.hs
@@ -2,14 +2,13 @@
 -- | Symantics for terminal grammars.
 module Language.Symantic.Grammar.Terminal where
 
-import Control.Monad
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
-import Prelude hiding (any)
 import qualified Data.Bool as Bool
 import qualified Data.Char as Char
 import qualified Data.List as List
 import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
 
 import Language.Symantic.Grammar.Fixity
 import Language.Symantic.Grammar.EBNF
@@ -18,28 +17,24 @@ import Language.Symantic.Grammar.EBNF
 -- | Terminal grammar.
 newtype Terminal g a
  =      Terminal { unTerminal :: g a }
- deriving (Functor, Gram_Terminal)
+ deriving (Functor, Gram_Char, Gram_String)
 deriving instance Gram_Rule g => Gram_Rule (Terminal g)
 
--- ** Class 'Gram_Terminal'
+-- ** Class 'Gram_Char'
 -- | Symantics for terminal grammars.
-class Gram_Rule g => Gram_Terminal g where
+class Gram_Rule g => Gram_Char g where
 	any    :: g Char
 	but    :: Terminal g Char -> Terminal g Char -> Terminal g Char
 	eoi    :: g ()
 	eol    :: g Char
 	space  :: g Char
 	char   :: Char -> g Char
-	string :: String -> g String
 	unicat :: Unicat -> g Char
 	range  :: (Char, Char) -> g Char
 	eol   = rule "NewLine" $ char '\n'
 	space = rule "Space" $ char ' '
-	-- string = foldr (\c -> (<*>) ((:) <$> char c)) (pure "")
-	-- string [] = pure []
-	-- string (c:cs) = (:) <$> char c <*> string cs
-deriving instance Gram_Terminal RuleEBNF
-instance Gram_Terminal EBNF where
+deriving instance Gram_Char RuleEBNF
+instance Gram_Char EBNF where
 	any  = ebnf_const "_"
 	Terminal (EBNF f) `but` Terminal (EBNF g) =
 		Terminal $ EBNF $ \bo po -> parenInfix po op $
@@ -52,23 +47,12 @@ instance Gram_Terminal EBNF where
 		where
 		escape c | Char.isPrint c && c /= '"' = Text.concat $ ["\"", Text.singleton c, "\""]
 		escape c = Text.concat ["U+", Text.pack $ show $ Char.ord c]
-	string s =
-		case List.break (\c -> Bool.not (Char.isPrint c) || c == '"') s of
-		 (ps, "")   -> raw ps
-		 ("", [c])  -> "" <$ char c
-		 (ps, [c])  -> "" <$ raw ps <* char c
-		 ("", c:rs) -> "" <$ char c <* string rs
-		 (ps, c:rs) -> "" <$ raw ps <* char c <* string rs
-		where
-		raw cs = ebnf_const $ Text.concat $ ["\"", Text.pack cs, "\""]
 	unicat = ebnf_const . Text.pack . show
 	range (l, h) = ebnf_const $ Text.concat
 	 [ runEBNF $ char l
 	 , "…"
 	 , runEBNF $ char h
 	 ]
-instance IsString (EBNF String) where
-	fromString = string
 
 -- *** Type 'Unicat'
 -- | Unicode category.
@@ -115,3 +99,29 @@ unicode_categories c =
 		 , Char.OtherSymbol
 		 ]
 	 Unicat cat -> [cat]
+
+-- ** Class 'Gram_String'
+class Functor g => Gram_String g where
+	string   :: String -> g String
+	{-
+	string = foldr (\c -> (<*>) ((:) <$> char c)) (pure "")
+	string [] = pure []
+	string (c:cs) = (:) <$> char c <*> string cs
+	-}
+	text     :: Text.Text -> g Text.Text
+	textLazy :: TL.Text -> g TL.Text
+	text t     = Text.pack <$> string (Text.unpack t)
+	textLazy t = TL.pack   <$> string (TL.unpack t)
+deriving instance Gram_String RuleEBNF
+instance Gram_String EBNF where
+	string s =
+		case List.break (\c -> Bool.not (Char.isPrint c) || c == '"') s of
+		 (ps, "")   -> raw ps
+		 ("", [c])  -> "" <$ char c
+		 (ps, [c])  -> "" <$ raw ps <* char c
+		 ("", c:rs) -> "" <$ char c <* string rs
+		 (ps, c:rs) -> "" <$ raw ps <* char c <* string rs
+		where
+		raw cs = ebnf_const $ Text.concat $ ["\"", Text.pack cs, "\""]
+instance IsString (EBNF String) where
+	fromString = string
diff --git a/symantic-grammar/Language/Symantic/Grammar/Test.hs b/symantic-grammar/Language/Symantic/Grammar/Test.hs
index 14a2194..dc1f719 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Test.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Test.hs
@@ -9,29 +9,30 @@ import Control.Applicative (Applicative(..))
 import Control.Monad
 import Data.Semigroup ((<>))
 import Data.String (IsString(..))
-import Prelude hiding (any, (^), exp)
 import qualified Control.Applicative as Gram_AltApp
 import qualified Data.Char as Char
 import qualified Data.Text as Text
 import qualified Text.Megaparsec as P
+import qualified Text.Megaparsec.Char as P
 
 import Language.Symantic.Grammar
 
 -- * Type 'ParsecT'
-type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
-instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
-	fromString = P.string
+type ParsecC e s = (P.Token s ~ Char, P.Stream s, Ord e)
+instance (ParsecC e s, Gram_String (P.ParsecT e s m)) => IsString (P.ParsecT e s m String) where
+	fromString = string
 instance ParsecC e s => Gram_Rule (P.ParsecT e s m) where
 	rule = P.label . Text.unpack
-instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
+instance ParsecC e s => Gram_Char (P.ParsecT e s m) where
 	any          = P.anyChar
 	eoi          = P.eof
 	char         = P.char
-	string       = P.string
 	unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
 		where cats = unicode_categories cat
 	range (l, h) = P.satisfy $ \c -> l <= c && c <= h
 	but (Terminal f) (Terminal p) = Terminal $ P.notFollowedBy (P.try p) *> f
+instance ParsecC e String => Gram_String (P.ParsecT e String m) where
+	string = P.string
 instance ParsecC e s => Gram_Alt (P.ParsecT e s m) where
 	empty  = Gram_AltApp.empty
 	(<+>)  = (Gram_AltApp.<|>)
@@ -48,18 +49,18 @@ instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
 	CF f <& Reg p      = CF $ P.lookAhead f <*> p
 	Reg f &> CF p      = CF $ P.lookAhead f <*> p
 	CF f `minus` Reg p = CF $ P.notFollowedBy (P.try p) *> f
-instance ParsecC e s => Gram_Comment (P.ParsecT e s m)
+instance ParsecC e String => Gram_Comment (P.ParsecT e String m)
 
 elide :: Text.Text -> String
 elide s | Text.length s > 42 = take 42 (Text.unpack s) <> ['…']
 elide s = Text.unpack s
 
-tests :: TestTree
-tests = testGroup "Grammar"
+hunits :: TestTree
+hunits = testGroup "Grammar"
  [ testGroup "Terminal" $
-	let (==>) inp exp =
-		testCase (elide exp) $
-		runEBNF (unTerminal (void inp)) @?= exp
+	let (==>) input expected =
+		testCase (elide expected) $
+		runEBNF (unTerminal (void input)) @?= expected
 		; infix 1 ==> in
 	 [ string "" ==> "\"\""
 	 , string "abé\"to" ==> "\"abé\", U+34, \"to\""
@@ -69,17 +70,17 @@ tests = testGroup "Grammar"
 	 , unicat (Unicat Char.LowercaseLetter) ==> "Unicat LowercaseLetter"
 	 ]
  , testGroup "Reg" $
-	let (==>) inp exp =
-		testCase (elide exp) $
-		runEBNF (unReg (void inp)) @?= exp
+	let (==>) input expected =
+		testCase (elide expected) $
+		runEBNF (unReg (void input)) @?= expected
 		; infix 1 ==> in
 	 [ (<>) <$> string "0" .*> someR (char '1') ==> "\"0\", {\"1\"}-"
 	 , (<>) <$> someL (char '1') <*. string "0" ==> "{\"1\"}-, \"0\""
 	 ]
  , testGroup "CF" $
-	let (==>) inp exp =
-		testCase (elide exp) $
-		runEBNF (unCF (void inp)) @?= exp
+	let (==>) input expected =
+		testCase (elide expected) $
+		runEBNF (unCF (void input)) @?= expected
 		; infix 1 ==> in
 	 [ (<>) <$> string "0" <*> string "1" ==> "\"0\", \"1\""
 	 , (<>) <$> string "0" <* string "X" <*> string "1" ==> "\"0\", \"X\", \"1\""
@@ -110,4 +111,4 @@ main :: IO ()
 main =
 	defaultMain $
 	testGroup "Language.Symantic"
-	 [tests]
+	 [hunits]
diff --git a/symantic-grammar/stack.yaml b/symantic-grammar/stack.yaml
index 5bbd150..1adfccd 100644
--- a/symantic-grammar/stack.yaml
+++ b/symantic-grammar/stack.yaml
@@ -1,3 +1,3 @@
-resolver: lts-9.0
+resolver: lts-10.5
 packages:
 - '.'
diff --git a/symantic-grammar/symantic-grammar.cabal b/symantic-grammar/symantic-grammar.cabal
index edb7c63..0159f03 100644
--- a/symantic-grammar/symantic-grammar.cabal
+++ b/symantic-grammar/symantic-grammar.cabal
@@ -22,7 +22,7 @@ tested-with: GHC==8.0.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.2.1.20170818
+version: 0.3.1.20180213
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
diff --git a/symantic-lib/Language/Symantic/Compiling/Test.hs b/symantic-lib/Language/Symantic/Compiling/Test.hs
index 5bb7982..033349f 100644
--- a/symantic-lib/Language/Symantic/Compiling/Test.hs
+++ b/symantic-lib/Language/Symantic/Compiling/Test.hs
@@ -13,6 +13,7 @@ import Control.Arrow (left)
 import Data.Functor.Identity (Identity(..))
 import Data.Text (Text)
 import Data.Type.Equality
+import Data.Void (Void)
 import qualified Control.Monad.Classes.Run as MC
 import qualified Control.Monad.Trans.State.Strict as SS
 import qualified Data.List as List
@@ -26,7 +27,7 @@ import Language.Symantic.Lib ()
 import Grammar.Megaparsec ()
 
 type G src ss =
- P.ParsecT P.Dec Text
+ P.ParsecT Void Text
            (SS.StateT (Imports NameTe, Modules src ss)
                       ((SS.StateT (Imports NameTy, ModulesTy src))
                                   Identity))
@@ -37,7 +38,7 @@ parseTe ::
  ModulesTyInj ss =>
  ModulesInj src ss =>
  Gram_Term src ss (G src ss) =>
- Text -> Either (P.ParseError Char P.Dec) (AST_Term src ss)
+ Text -> Either (P.ParseError Char Void) (AST_Term src ss)
 parseTe inp =
 	let modsTe :: Modules src ss = either (error . show) id modulesInj in
 	let impsTe = [] `importModules` modsTe in
@@ -69,7 +70,7 @@ readTe ::
  ) =>
  Text ->
  Either ( Type src '[] t
-        , Either (P.ParseError Char P.Dec)
+        , Either (P.ParseError Char Void)
                  (Error_Term src) )
         (Type src '[] t, t, Text) ->
  TestTree
diff --git a/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs b/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs
index 424c41a..2e50260 100644
--- a/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs
+++ b/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs
@@ -19,7 +19,9 @@ import qualified Control.Applicative as Alt
 import qualified Control.Monad.Classes as MC
 import qualified Data.Char as Char
 import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
 import qualified Text.Megaparsec as P
+import qualified Text.Megaparsec.Char as P
 
 import Language.Symantic.Grammar as Sym
 import qualified Language.Symantic as Sym
@@ -27,8 +29,8 @@ import Language.Symantic.Lib ()
 
 -- * Type 'ParsecC'
 -- | Convenient alias for defining instances involving 'P.ParsecT'.
-type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
-instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
+type ParsecC e s = (P.Token s ~ Char, P.Stream s, Ord e)
+instance ParsecC e [Char] => IsString (P.ParsecT e [Char] m [Char]) where
 	fromString = P.string
 
 --
@@ -105,15 +107,20 @@ instance (ParsecC e s, Show err) => Sym.Gram_Error err (P.ParsecT e s m) where
 		 Right a -> return a
 instance ParsecC e s => Sym.Gram_Rule (P.ParsecT e s m) where
 	rule = P.label . Text.unpack
-instance ParsecC e s => Sym.Gram_Terminal (P.ParsecT e s m) where
+instance ParsecC e s => Sym.Gram_Char (P.ParsecT e s m) where
 	any          = P.anyChar
 	eoi          = P.eof
 	char         = P.char
-	string       = P.string
 	unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
 		where cats = unicode_categories cat
 	range (l, h) = P.satisfy $ \c -> l <= c && c <= h
 	Terminal f `but` Terminal p = Terminal $ P.notFollowedBy (P.try p) *> f
+instance ParsecC e String => Sym.Gram_String (P.ParsecT e String m) where
+	string = P.string
+instance ParsecC e Text.Text => Sym.Gram_String (P.ParsecT e Text.Text m) where
+	string t   = Text.unpack <$> P.string (Text.pack t)
+	text       = P.string
+	textLazy t = TL.fromStrict <$> P.string (TL.toStrict t)
 instance ParsecC e s => Sym.Gram_Alt (P.ParsecT e s m) where
 	empty  = Alt.empty
 	(<+>)  = (Alt.<|>)
@@ -136,32 +143,39 @@ instance ParsecC e s => Sym.Gram_CF (P.ParsecT e s m) where
 	CF f <& Reg p        = CF $ P.lookAhead f <*> p
 	Reg f &> CF p        = CF $ P.lookAhead f <*> p
 	minus (CF f) (Reg p) = CF $ P.notFollowedBy (P.try p) *> f
-instance ParsecC e s => Sym.Gram_Comment (P.ParsecT e s m)
-instance ParsecC e s => Sym.Gram_Op (P.ParsecT e s m)
-instance ParsecC e s => Sym.Gram_Mod (P.ParsecT e s m)
-instance ParsecC e s => Sym.Gram_Type_Name (P.ParsecT e s m)
-instance ParsecC e s => Sym.Gram_Term_Name (P.ParsecT e s m)
+instance (ParsecC e s, Sym.Gram_String (P.ParsecT e s m)) => Sym.Gram_Comment (P.ParsecT e s m)
+instance (ParsecC e s, Sym.Gram_String (P.ParsecT e s m)) => Sym.Gram_Op (P.ParsecT e s m)
+instance (ParsecC e s, Sym.Gram_String (P.ParsecT e s m)) => Sym.Gram_Mod (P.ParsecT e s m)
+instance (ParsecC e s, Sym.Gram_String (P.ParsecT e s m)) => Sym.Gram_Type_Name (P.ParsecT e s m)
+instance (ParsecC e s, Sym.Gram_String (P.ParsecT e s m)) => Sym.Gram_Term_Name (P.ParsecT e s m)
 instance -- Sym.Gram_Type
  ( ParsecC e s
+ , Sym.Gram_String (P.ParsecT e s m)
  , Gram_Source src (P.ParsecT e s m)
  , Show src
  , MC.MonadState ( Sym.Imports Sym.NameTy
-                 , Sym.ModulesTy src ) (P.ParsecT e s m)
+                 , Sym.ModulesTy src )
+                 (P.ParsecT e s m)
  ) => Sym.Gram_Type src (P.ParsecT e s m)
 instance -- Sym.Gram_Term_Type
  ( ParsecC e s
+ , Sym.Gram_String (P.ParsecT e s m)
  , Show src
  , MC.MonadState ( Sym.Imports Sym.NameTy
-                 , Sym.ModulesTy src ) (P.ParsecT e s m)
+                 , Sym.ModulesTy src )
+                 (P.ParsecT e s m)
  , Gram_Source src           (P.ParsecT e s m)
  ) => Sym.Gram_Term_Type src (P.ParsecT e s m)
 instance -- Sym.Gram_Term
  ( ParsecC e s
+ , Sym.Gram_String (P.ParsecT e s m)
  , Show src
  , MC.MonadState ( Sym.Imports Sym.NameTy
-                 , Sym.ModulesTy src )  (P.ParsecT e s m)
+                 , Sym.ModulesTy src )
+                 (P.ParsecT e s m)
  , MC.MonadState ( Sym.Imports Sym.NameTe
-                 , Sym.Modules src ss ) (P.ParsecT e s m)
+                 , Sym.Modules src ss )
+                 (P.ParsecT e s m)
  , Sym.Gram_Source src        (P.ParsecT e s m)
  , Sym.Gram_Term_Atoms src ss (P.ParsecT e s m)
  ) => Sym.Gram_Term src ss    (P.ParsecT e s m)
diff --git a/symantic-lib/Language/Symantic/Lib/Alternative.hs b/symantic-lib/Language/Symantic/Lib/Alternative.hs
index 8338b49..4f69790 100644
--- a/symantic-lib/Language/Symantic/Lib/Alternative.hs
+++ b/symantic-lib/Language/Symantic/Lib/Alternative.hs
@@ -4,7 +4,7 @@
 module Language.Symantic.Lib.Alternative where
 
 import Control.Applicative (Alternative)
-import Prelude hiding (Functor(..), (<$>), id, const)
+import Prelude hiding (Functor(..))
 import qualified Control.Applicative as Alternative
 
 import Language.Symantic
diff --git a/symantic-lib/Language/Symantic/Lib/Applicative.hs b/symantic-lib/Language/Symantic/Lib/Applicative.hs
index b83346c..7212b90 100644
--- a/symantic-lib/Language/Symantic/Lib/Applicative.hs
+++ b/symantic-lib/Language/Symantic/Lib/Applicative.hs
@@ -4,7 +4,7 @@
 module Language.Symantic.Lib.Applicative where
 
 import Control.Applicative (Applicative)
-import Prelude hiding (Functor(..), (<$>), Applicative(..), id, const)
+import Prelude hiding (Functor(..), (<$>), Applicative(..))
 import qualified Control.Applicative as Applicative
 import qualified Data.Function as Fun
 
diff --git a/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs b/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs
index 150714a..5e2153e 100644
--- a/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs
@@ -4,7 +4,6 @@ module Lib.Applicative.Test where
 import Test.Tasty
 
 import Data.Proxy (Proxy(..))
-import Prelude hiding ((&&), not, (||))
 
 import Language.Symantic.Lib
 import Compiling.Test
diff --git a/symantic-lib/Language/Symantic/Lib/Char.hs b/symantic-lib/Language/Symantic/Lib/Char.hs
index 0086fac..2c4e5d8 100644
--- a/symantic-lib/Language/Symantic/Lib/Char.hs
+++ b/symantic-lib/Language/Symantic/Lib/Char.hs
@@ -6,7 +6,7 @@ module Language.Symantic.Lib.Char where
 import qualified Data.Char as Char
 import qualified Data.Text as Text
 
-import Language.Symantic.Grammar hiding (char, any)
+import Language.Symantic.Grammar hiding (char)
 import qualified Language.Symantic.Grammar as G
 import Language.Symantic
 import Language.Symantic.Lib.List (tyList)
@@ -78,7 +78,7 @@ instance
 		 )
 	 ]
 		where
-		tickG :: Gram_Terminal g' => g' Char
+		tickG :: Gram_Char g' => g' Char
 		tickG = G.char '\''
 instance (Source src, SymInj ss Char) => ModuleFor src ss Char where
 	moduleFor = ["Char"] `moduleWhere`
diff --git a/symantic-lib/Language/Symantic/Lib/Foldable.hs b/symantic-lib/Language/Symantic/Lib/Foldable.hs
index 94e5823..2596c48 100644
--- a/symantic-lib/Language/Symantic/Lib/Foldable.hs
+++ b/symantic-lib/Language/Symantic/Lib/Foldable.hs
@@ -10,7 +10,7 @@ import Data.Foldable (Foldable)
 import qualified Data.Foldable as Foldable
 import Prelude hiding (Foldable(..)
  , all, and, any, concat, concatMap
- , mapM_, notElem, or, sequence, sequence_)
+ , mapM_, notElem, or, sequence_)
 
 import Language.Symantic
 import Language.Symantic.Lib.Alternative (tyAlternative)
diff --git a/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs b/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs
index 1cb2476..82b406c 100644
--- a/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs
@@ -4,7 +4,6 @@ module Lib.Foldable.Test where
 import Test.Tasty
 
 import Data.Proxy (Proxy(..))
-import Prelude hiding ((&&), not, (||))
 
 import Language.Symantic.Lib
 import Compiling.Test
diff --git a/symantic-lib/Language/Symantic/Lib/Functor/Test.hs b/symantic-lib/Language/Symantic/Lib/Functor/Test.hs
index 9b7bb52..508e7eb 100644
--- a/symantic-lib/Language/Symantic/Lib/Functor/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Functor/Test.hs
@@ -4,7 +4,6 @@ module Lib.Functor.Test where
 import Test.Tasty
 
 import Data.Proxy (Proxy(..))
-import Prelude hiding ((&&), not, (||))
 
 import Language.Symantic ()
 import Language.Symantic.Lib
diff --git a/symantic-lib/Language/Symantic/Lib/Map/Test.hs b/symantic-lib/Language/Symantic/Lib/Map/Test.hs
index a50bec7..ff112e2 100644
--- a/symantic-lib/Language/Symantic/Lib/Map/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Map/Test.hs
@@ -6,7 +6,6 @@ import Test.Tasty
 import Data.Map.Strict (Map)
 import Data.Proxy (Proxy(..))
 import Data.Text as Text
-import Prelude hiding (zipWith)
 import qualified Data.Map.Strict as Map
 
 import Language.Symantic.Lib
diff --git a/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs b/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs
index 8271117..11a5784 100644
--- a/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs
@@ -4,7 +4,6 @@ module Lib.MonoFunctor.Test where
 import Test.Tasty
 
 import Data.Proxy (Proxy(..))
-import Prelude hiding (zipWith)
 import qualified Data.MonoTraversable as MT
 
 import Language.Symantic.Lib
diff --git a/symantic-lib/Language/Symantic/Lib/Test.hs b/symantic-lib/Language/Symantic/Lib/Test.hs
index f36ba58..ad901e9 100644
--- a/symantic-lib/Language/Symantic/Lib/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Test.hs
@@ -4,7 +4,7 @@ module Lib.Test where
 
 import Test.Tasty
 
-import Prelude hiding ((&&), not, (||), (==), id)
+import Prelude hiding ((&&), not, (||), id)
 
 import Language.Symantic
 import Language.Symantic.Lib
diff --git a/symantic-lib/Language/Symantic/Lib/Text.hs b/symantic-lib/Language/Symantic/Lib/Text.hs
index 49e9375..9598127 100644
--- a/symantic-lib/Language/Symantic/Lib/Text.hs
+++ b/symantic-lib/Language/Symantic/Lib/Text.hs
@@ -8,7 +8,7 @@ import qualified Data.MonoTraversable as MT
 import qualified Data.Sequences as Seqs
 import qualified Data.Text as Text
 
-import Language.Symantic.Grammar
+import Language.Symantic.Grammar hiding (text)
 import Language.Symantic
 import Language.Symantic.Lib.Char ()
 import Language.Symantic.Lib.MonoFunctor (Element)
diff --git a/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs b/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs
index 96e01af..348f056 100644
--- a/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs
+++ b/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs
@@ -4,7 +4,6 @@ module Lib.Tuple2.Test where
 import Test.Tasty
 
 import Data.Proxy (Proxy(..))
-import Prelude hiding ((&&), not, (||))
 
 import Language.Symantic.Lib
 import Compiling.Test
diff --git a/symantic-lib/Language/Symantic/Lib/Unit.hs b/symantic-lib/Language/Symantic/Lib/Unit.hs
index 71fd7af..c4bd79c 100644
--- a/symantic-lib/Language/Symantic/Lib/Unit.hs
+++ b/symantic-lib/Language/Symantic/Lib/Unit.hs
@@ -3,8 +3,6 @@
 -- | Symantic for '()'.
 module Language.Symantic.Lib.Unit where
 
-import Prelude hiding ((&&), not, (||))
-
 import Language.Symantic
 import Language.Symantic.Grammar
 
diff --git a/symantic-lib/Language/Symantic/Typing/Test.hs b/symantic-lib/Language/Symantic/Typing/Test.hs
index 194f0a5..7033170 100644
--- a/symantic-lib/Language/Symantic/Typing/Test.hs
+++ b/symantic-lib/Language/Symantic/Typing/Test.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Typing.Test where
@@ -16,6 +17,7 @@ import Data.NonNull (NonNull)
 import Data.Proxy
 import Data.Ratio (Ratio)
 import Data.Text (Text)
+import Data.Void (Void)
 import GHC.Exts (Constraint)
 import Prelude hiding (exp)
 import qualified Control.Monad.Classes.Run as MC
@@ -26,11 +28,10 @@ import qualified Data.MonoTraversable as MT
 import qualified Data.Sequences as Seqs
 import qualified System.IO as IO
 import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Prim as P
 
 import Language.Symantic.Grammar
 import Language.Symantic
-import Language.Symantic.Lib hiding ((<$>), (<*), show)
+import Language.Symantic.Lib hiding ((<$>), (<*))
 
 import Grammar.Megaparsec ()
 
@@ -105,7 +106,7 @@ tests = testGroup "Typing" $
 	let run inp (TypeT exp :: TypeT SRC '[]) =
 		testCase inp $ got @?= Right (Right $ TypeVT exp)
 		where
-		got :: Either (P.ParseError Char P.Dec)
+		got :: Either (P.ParseError Char Void)
 		              (Either (Error_Type SRC) (TypeVT SRC))
 		got = readType <$> parseTy inp
 		in
@@ -151,7 +152,7 @@ tests = testGroup "Typing" $
 		let run inp = testCase inp $ got @?= Left ()
 			where
 			got :: Either () (AST_Type SRC)
-			got = left (\(_::P.ParseError (P.Token String) P.Dec) -> ()) $ parseTy inp in
+			got = left (\(_::P.ParseError (P.Token String) Void) -> ()) $ parseTy inp in
 		run <$>
 		 [ "Bool, Int"
 		 , "(Bool -> Int) Char"
@@ -160,7 +161,7 @@ tests = testGroup "Typing" $
 	 , testGroup "Compiling errors" $
 		let run inp = testCase inp $ got @?= Right (Left ())
 			where
-			got :: Either (P.ParseError Char P.Dec) (Either () (TypeVT SRC))
+			got :: Either (P.ParseError Char Void) (Either () (TypeVT SRC))
 			got = left (Fun.const ()) . readType <$> parseTy inp in
 		run <$>
 		 [ "Bool Int"
diff --git a/symantic-lib/stack.yaml b/symantic-lib/stack.yaml
index f68b004..79f1dab 100644
--- a/symantic-lib/stack.yaml
+++ b/symantic-lib/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-9.0
+resolver: lts-10.5
 packages:
 - '.'
 - location: '../symantic'
@@ -7,6 +7,7 @@ packages:
   extra-dep: true
 - location: '../symantic-document'
   extra-dep: true
+- location: '../monad-classes'
+  extra-dep: true
 extra-deps:
-- monad-classes-0.3.2.0
 - peano-0.1.0.1
diff --git a/symantic/Language/Symantic/Compiling/Beta.hs b/symantic/Language/Symantic/Compiling/Beta.hs
index 6c6fc37..5fa44a1 100644
--- a/symantic/Language/Symantic/Compiling/Beta.hs
+++ b/symantic/Language/Symantic/Compiling/Beta.hs
@@ -11,12 +11,12 @@ import Language.Symantic.Compiling.Term
 -- | Term application: apply second given 'TermT' to the first,
 -- applying embedded 'TeSym's, or return an error.
 betaTerm ::
- forall src ss es vs fun arg.
+ forall src ss ts vs fun arg.
  SourceInj (TypeVT src) src =>
  Constable (->) =>
- Term src ss es vs (fun::K.Type) ->
- Term src ss es vs (arg::K.Type) ->
- Either (Error_Beta src) (TermT src ss es vs)
+ Term src ss ts vs (fun::K.Type) ->
+ Term src ss ts vs (arg::K.Type) ->
+ Either (Error_Beta src) (TermT src ss ts vs)
 betaTerm (Term qf tf (TeSym te_fun)) (Term qa ta (TeSym te_arg)) =
 	case tf of
 	 TyApp _ (TyApp _ a2b a2b_a) a2b_b
@@ -41,8 +41,8 @@ betaTerm (Term qf tf (TeSym te_fun)) (Term qa ta (TeSym te_arg)) =
 betaTerms ::
  SourceInj (TypeVT src) src =>
  Constable (->) =>
- BinTree (TermVT src ss es) ->
- Either (Error_Beta src) (TermVT src ss es)
+ BinTree (TermVT src ss ts) ->
+ Either (Error_Beta src) (TermVT src ss ts)
 betaTerms t =
 	collapseBT (\acc ele -> do
 		TermVT (Term qf tf te_fun) <- acc
@@ -61,8 +61,10 @@ betaTerms t =
 			let tf'' = subst mgu tf'
 			let ta'' = subst mgu ta'
 			TermT (Term qr tr te_res) <- betaTerm (Term qf'' tf'' te_fun) (Term qa'' ta'' te_arg)
-			normalizeVarsTy (qr #> tr) $ \(TyApp _ (TyApp _ _c qr') tr') ->
+			normalizeVarsTy (qr #> tr) $ \case
+			 TyApp _ (TyApp _ _c qr') tr' ->
 				Right $ TermVT $ Term qr' tr' te_res
+			 _ -> undefined -- FIXME: as of GHC 8.2, GHC is no longer clever enough to rule out other cases
 	 ) (Right <$> t)
 
 -- * Type 'Error_Beta'
diff --git a/symantic/Language/Symantic/Compiling/Grammar.hs b/symantic/Language/Symantic/Compiling/Grammar.hs
index fd3e37e..a9fec95 100644
--- a/symantic/Language/Symantic/Compiling/Grammar.hs
+++ b/symantic/Language/Symantic/Compiling/Grammar.hs
@@ -10,7 +10,7 @@ import Control.Arrow (left)
 import Control.Monad (void)
 import Data.Semigroup (Semigroup(..))
 import Data.Map.Strict (Map)
-import Prelude hiding (mod, not, any)
+import Prelude hiding (any)
 import qualified Data.Function as Fun
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as Text
@@ -21,7 +21,7 @@ import Language.Symantic.Compiling.Module
 
 -- * Class 'Gram_Term_Name'
 class
- ( Gram_Terminal g
+ ( Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_Try g
@@ -98,7 +98,7 @@ instance Gram_Term_Name RuleEBNF
 
 -- * Class 'Gram_Term_Type'
 class
- ( Gram_Terminal g
+ ( Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_AltApp g
@@ -145,7 +145,7 @@ data Error_Term_Gram
 class
  ( Gram_Source src g
  , Gram_Error Error_Term_Gram g
- , Gram_Terminal g
+ , Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_App g
@@ -224,7 +224,7 @@ class
 			lexeme $
 				g_ModNameTeId <* g_backquote <+>
 				g_ModNameTeOp
-		g_backquote :: Gram_Terminal g' => g' Char
+		g_backquote :: Gram_Char g' => g' Char
 		g_backquote = char '`'
 	
 	g_term_atom :: CF g  (AST_Term src ss)
diff --git a/symantic/Language/Symantic/Compiling/Module.hs b/symantic/Language/Symantic/Compiling/Module.hs
index 4436940..fdab23d 100644
--- a/symantic/Language/Symantic/Compiling/Module.hs
+++ b/symantic/Language/Symantic/Compiling/Module.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Language.Symantic.Compiling.Module where
@@ -13,7 +12,7 @@ import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup(..))
 import Data.Set (Set)
 import Data.String (IsString(..))
-import Prelude hiding (mod, not, any)
+import Prelude hiding (mod, not)
 import qualified Data.Map.Strict as Map
 
 import Language.Symantic.Grammar
diff --git a/symantic/Language/Symantic/Compiling/Term.hs b/symantic/Language/Symantic/Compiling/Term.hs
index 752868a..3b2da61 100644
--- a/symantic/Language/Symantic/Compiling/Term.hs
+++ b/symantic/Language/Symantic/Compiling/Term.hs
@@ -165,7 +165,7 @@ data CtxTe (term::K.Type -> K.Type) (hs::[K.Type]) where
 infixr 5 `CtxTeS`
 
 -- ** Type 'TermDef'
--- | Convenient type alias for defining 'Term'.
+-- | Convenient type alias to define a 'Term'.
 type TermDef s vs t = forall src ss ts. Source src => SymInj ss s => Term src ss ts vs t
 
 -- ** Type family 'Sym'
diff --git a/symantic/Language/Symantic/Interpreting/View.hs b/symantic/Language/Symantic/Interpreting/View.hs
index 94d0b01..ccff895 100644
--- a/symantic/Language/Symantic/Interpreting/View.hs
+++ b/symantic/Language/Symantic/Interpreting/View.hs
@@ -13,10 +13,10 @@ import Language.Symantic.Grammar
 -- | Interpreter's data.
 newtype View a
  =      View
- {    unView -- Inherited attribuctx:
+ {    unView -- Inherited attributes:
              :: (Infix, Side)
              -> DepthLam
-             -- Synthetised attribuctx:
+             -- Synthetised attributes:
              -> Text
  }
 type DepthLam = Int
diff --git a/symantic/Language/Symantic/Typing/Document.hs b/symantic/Language/Symantic/Typing/Document.hs
index 0bf9b97..ff7c4b8 100644
--- a/symantic/Language/Symantic/Typing/Document.hs
+++ b/symantic/Language/Symantic/Typing/Document.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeInType #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.Symantic.Typing.Document where
 
@@ -54,8 +55,8 @@ docType conf@Config_Doc_Type{config_Doc_Type_imports=imps} pr ty =
 	go v2n (infixB SideL pr, SideL) ty
 	where
 	go ::
-	 forall x.
-	 (Map IndexVar Name) -> -- names of variables
+	 forall kx (x::kx).
+	 Map IndexVar Name -> -- names of variables
 	 (Infix, Side) ->
 	 Type src vs x -> d
 	-- Var
diff --git a/symantic/Language/Symantic/Typing/Grammar.hs b/symantic/Language/Symantic/Typing/Grammar.hs
index a16d0a6..8260ab5 100644
--- a/symantic/Language/Symantic/Typing/Grammar.hs
+++ b/symantic/Language/Symantic/Typing/Grammar.hs
@@ -11,7 +11,6 @@ import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
-import Prelude hiding (any)
 import qualified Data.Char as Char
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as Text
@@ -96,7 +95,7 @@ instance
 
 -- * Class 'Gram_Mod'
 class
- ( Gram_Terminal g
+ ( Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_Try g
@@ -130,7 +129,7 @@ instance Gram_Mod RuleEBNF
 
 -- * Class 'Gram_Type_Name'
 class
- ( Gram_Terminal g
+ ( Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_Try g
@@ -189,7 +188,7 @@ instance Gram_Type_Name RuleEBNF
 -- | Read an 'AST_Type' from a textual source.
 class
  ( Gram_Source src g
- , Gram_Terminal g
+ , Gram_Char g
  , Gram_Rule g
  , Gram_Alt g
  , Gram_Try g
diff --git a/symantic/Language/Symantic/Typing/Peano.hs b/symantic/Language/Symantic/Typing/Peano.hs
index b05f419..dc93f87 100644
--- a/symantic/Language/Symantic/Typing/Peano.hs
+++ b/symantic/Language/Symantic/Typing/Peano.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -fno-warn-missing-methods #-}
 -- | Natural numbers inductivey defined at the type-level, and of kind @*@.
 module Language.Symantic.Typing.Peano where
 
diff --git a/symantic/Language/Symantic/Typing/Type.hs b/symantic/Language/Symantic/Typing/Type.hs
index 2b95a5d..75907e8 100644
--- a/symantic/Language/Symantic/Typing/Type.hs
+++ b/symantic/Language/Symantic/Typing/Type.hs
@@ -727,7 +727,7 @@ kindOfType (TyApp _src f _a) =
 kindOfType (TyVar _src _n v)         = kindOfVar v
 kindOfType (TyFam _src _len fam _as) = kindOfConst fam
 
--- | Remove unused 'Var's from ther context.
+-- | Remove unused 'Var's from the context.
 normalizeVarsTy ::
  Type src vs (t::kt) ->
  (forall vs'. Type src vs' (t::kt) -> ret) -> ret
diff --git a/symantic/Language/Symantic/Typing/Unify.hs b/symantic/Language/Symantic/Typing/Unify.hs
index ec2129c..c0709df 100644
--- a/symantic/Language/Symantic/Typing/Unify.hs
+++ b/symantic/Language/Symantic/Typing/Unify.hs
@@ -146,7 +146,7 @@ spineTy ::
  (TypeT src vs, [TypeT src vs])
 spineTy typ = go [] typ
 	where
-	go :: forall x. [TypeT src vs] -> Type src vs x -> (TypeT src vs, [TypeT src vs])
+	go :: forall kx (x::kx). [TypeT src vs] -> Type src vs x -> (TypeT src vs, [TypeT src vs])
 	go ctx (TyApp _ (TyApp _ (TyConst _ _ c) _q) t)
 	 | Just HRefl <- proj_ConstKi @(K (#>)) @(#>) c
 	 = go ctx t -- NOTE: skip the constraint @q@.
diff --git a/symantic/Language/Symantic/Typing/Variable.hs b/symantic/Language/Symantic/Typing/Variable.hs
index e9658bc..5d1f991 100644
--- a/symantic/Language/Symantic/Typing/Variable.hs
+++ b/symantic/Language/Symantic/Typing/Variable.hs
@@ -9,18 +9,13 @@ module Language.Symantic.Typing.Variable where
 import Data.Proxy (Proxy(..))
 import Data.String (IsString(..))
 import Data.Text (Text)
-import Data.Type.Equality ((:~:)(..))
+import Data.Type.Equality ((:~:)(..), (:~~:)(..))
 import qualified Data.Kind as K
 
 import Language.Symantic.Grammar
 import Language.Symantic.Typing.List
 import Language.Symantic.Typing.Kind
 
--- | /Heterogeneous propositional equality/:
--- like (:~:) but prove also that the kinds are equal.
-data (:~~:) (a::ka) (b::kb) where
-	HRefl :: a :~~: a
-
 -- * Type 'Var'
 -- | A /type variable/, indexed amongst a type-level list.
 -- @v@ is wrapped within a 'Proxy' to have a kind-heterogeneous list.
diff --git a/symantic/README.md b/symantic/README.md
index e5e7f0c..226c757 100644
--- a/symantic/README.md
+++ b/symantic/README.md
@@ -157,7 +157,7 @@ without the following seminal works:
 * `PolyKinds` for avoiding a lot of uses of `Proxy`.
 * `Rank2Types` or `ExistentialQuantification` for parsing `GADT`s.
 * `TypeApplications` for having a more concise syntax
-  to build `Type` (eg. `tyConst `Bool`).
+  to build `Type` (eg. `tyConst @Bool`).
 * `TypeFamilies` for type-level programming.
 * `TypeInType` (introduced in GHC 8.0.1)
   for `Type` to also bind a kind equality for the type `t` it encodes.
diff --git a/symantic/stack.yaml b/symantic/stack.yaml
index 5383e82..73596c5 100644
--- a/symantic/stack.yaml
+++ b/symantic/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-9.0
+resolver: lts-10.5
 packages:
 - '.'
 - location: '../symantic-grammar'
diff --git a/symantic/symantic.cabal b/symantic/symantic.cabal
index 2fec805..8f30af1 100644
--- a/symantic/symantic.cabal
+++ b/symantic/symantic.cabal
@@ -17,11 +17,11 @@ maintainer: Julien Moutinho <julm+symantic@autogeree.net>
 name: symantic
 stability: experimental
 synopsis: Library for Typed Tagless-Final Higher-Order Composable DSL
-tested-with: GHC==8.0.2
+tested-with: GHC==8.2.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 6.3.0.20170807
+version: 6.3.1.20180213
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
@@ -44,8 +44,12 @@ Library
     TypeApplications
     TypeFamilies
     TypeOperators
-  ghc-options: -Wall
-               -fno-warn-tabs
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
   default-language: Haskell2010
   exposed-modules:
     Language.Symantic
-- 
2.44.1


From c670efdc8823b57dcacd6210c2232f472b5f1455 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 13 Feb 2018 06:07:52 +0100
Subject: [PATCH 04/16] Add lower version bounds to all dependencies.

---
 symantic-document/symantic-document.cabal     | 14 ++-
 .../Language/Symantic/Grammar/EBNF.hs         |  1 -
 symantic-grammar/symantic-grammar.cabal       | 30 +++---
 symantic-lib/symantic-lib.cabal               | 96 +++++++++++--------
 symantic/symantic.cabal                       | 12 +--
 5 files changed, 86 insertions(+), 67 deletions(-)

diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index faaccbe..e3386e9 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -42,7 +42,12 @@ Library
     TupleSections
     TypeFamilies
     TypeOperators
-  ghc-options: -Wall -fno-warn-tabs
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
   exposed-modules:
     Language.Symantic.Document
     Language.Symantic.Document.ANSI
@@ -51,7 +56,6 @@ Library
     Language.Symantic.Document.Sym
     Language.Symantic.Document.Valid
   build-depends:
-    ansi-terminal
-    , base >= 4.6 && < 5
-    , text
-    -- , transformers >= 0.4 && < 0.5
+      ansi-terminal >= 0.7
+    , base          >= 4.6 && < 5
+    , text          >= 1.2
diff --git a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
index 63d040f..9c414fa 100644
--- a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
@@ -1,7 +1,6 @@
 module Language.Symantic.Grammar.EBNF where
 
 import Control.Applicative (Applicative(..))
-import Control.Monad
 import Data.Semigroup
 import Data.Text (Text)
 import qualified Data.Text as Text
diff --git a/symantic-grammar/symantic-grammar.cabal b/symantic-grammar/symantic-grammar.cabal
index 0159f03..438ef7f 100644
--- a/symantic-grammar/symantic-grammar.cabal
+++ b/symantic-grammar/symantic-grammar.cabal
@@ -18,7 +18,7 @@ maintainer: Julien Moutinho <julm+symantic@autogeree.net>
 name: symantic-grammar
 stability: experimental
 synopsis: Library for symantic grammars.
-tested-with: GHC==8.0.2
+tested-with: GHC==8.2.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
@@ -40,10 +40,12 @@ Library
     OverloadedStrings
     ScopedTypeVariables
     StandaloneDeriving
-  ghc-options: -Wall
-               -fwarn-incomplete-patterns
-               -fno-warn-tabs
-               -fprint-explicit-kinds
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
   default-language: Haskell2010
   exposed-modules:
     Language.Symantic.Grammar
@@ -58,8 +60,8 @@ Library
     Language.Symantic.Grammar.Source
     Language.Symantic.Grammar.Error
   build-depends:
-    base >= 4.6 && < 5
-    , text
+      base >= 4.6 && < 5
+    , text >= 1.2
 
 Test-Suite symantic-grammar-test
   type: exitcode-stdio-1.0
@@ -78,10 +80,10 @@ Test-Suite symantic-grammar-test
   main-is: Grammar/Test.hs
   other-modules:
   build-depends:
-    base >= 4.6 && < 5
-    , megaparsec
-    , symantic-grammar
-    , tasty >= 0.11
-    , tasty-hunit
-    , text
-    , transformers
+      symantic-grammar
+    , base         >= 4.6 && < 5
+    , megaparsec   >= 6.3
+    , tasty        >= 0.11
+    , tasty-hunit  >= 0.9
+    , text         >= 1.2
+    , transformers >= 0.5
diff --git a/symantic-lib/symantic-lib.cabal b/symantic-lib/symantic-lib.cabal
index 86563a6..218bb36 100644
--- a/symantic-lib/symantic-lib.cabal
+++ b/symantic-lib/symantic-lib.cabal
@@ -15,11 +15,11 @@ maintainer: Julien Moutinho <julm+symantic@autogeree.net>
 name: symantic-lib
 stability: experimental
 synopsis: Symantics for common types.
-tested-with: GHC==8.0.2
+tested-with: GHC==8.2.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.0.2.20170818
+version: 0.0.3.20180213
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
@@ -42,9 +42,13 @@ Library
     TypeApplications
     TypeFamilies
     TypeOperators
-  ghc-options: -Wall
-               -fno-warn-tabs
-               -fprint-explicit-kinds
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+    -fprint-explicit-kinds
   default-language: Haskell2010
   exposed-modules:
     Language.Symantic.Lib
@@ -84,15 +88,15 @@ Library
     Language.Symantic.Lib.Tuple2
     Language.Symantic.Lib.Unit
   build-depends:
-    base >= 4.6 && < 5
-    , containers
-    , ghc-prim
-    , monad-classes
-    , mono-traversable
-    , symantic >= 6.0
+      symantic
     , symantic-grammar
-    , transformers
-    , text
+    , base             >= 4.6 && < 5
+    , containers       >= 0.5
+    , ghc-prim         >= 0.5
+    , monad-classes    >= 0.3.2
+    , mono-traversable >= 1.0
+    , transformers     >= 0.5
+    , text             >= 1.2
 
 Test-Suite symantic-test
   type: exitcode-stdio-1.0
@@ -109,12 +113,17 @@ Test-Suite symantic-test
     TypeFamilies
     TypeOperators
   default-language: Haskell2010
-  ghc-options: -main-is Test
-               -Wall
-               -fno-warn-tabs
-               -- -O0
-               -- -fmax-simplifier-iterations=0
-               -- -dshow-passes
+  ghc-options:
+    -main-is Test
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+    -fprint-explicit-kinds
+    -- -O0
+    -- -fmax-simplifier-iterations=0
+    -- -dshow-passes
   hs-source-dirs: Language/Symantic
   main-is: Test.hs
   other-modules:
@@ -131,18 +140,18 @@ Test-Suite symantic-test
     Lib.Tuple2.Test
     Typing.Test
   build-depends:
-    base >= 4.6 && < 5
-    , containers
-    , megaparsec
-    , monad-classes
-    , mono-traversable
+      symantic
     , symantic-grammar
-    , symantic
     , symantic-lib
-    , tasty >= 0.11
-    , tasty-hunit
-    , text
-    , transformers
+    , base             >= 4.6 && < 5
+    , containers       >= 0.5
+    , megaparsec       >= 6.3
+    , monad-classes    >= 0.3.2
+    , mono-traversable >= 1.0
+    , tasty            >= 0.11
+    , tasty-hunit      >= 0.9
+    , text             >= 1.2
+    , transformers     >= 0.5
 
 Test-Suite ebnf
   type: exitcode-stdio-1.0
@@ -164,21 +173,26 @@ Test-Suite ebnf
     TypeFamilies
     TypeApplications
     TypeOperators
-  ghc-options: -main-is Grammar.EBNF
-               -Wall
-               -fno-warn-tabs
-               -fprint-potential-instances
+  ghc-options:
+    -main-is Grammar.EBNF
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+    -fprint-explicit-kinds
+    -fprint-potential-instances
   main-is: Grammar/EBNF.hs
   default-language: Haskell2010
   hs-source-dirs: Language/Symantic
   build-depends:
-    base >= 4.6 && < 5
-    , containers
-    , megaparsec
+      symantic
     , symantic-grammar
-    , symantic
     , symantic-lib
-    , transformers
-    , tasty >= 0.11
-    , tasty-hunit
-    , text
+    , base         >= 4.6 && < 5
+    , containers   >= 0.5
+    , megaparsec   >= 6.3
+    , transformers >= 0.5
+    , tasty        >= 0.11
+    , tasty-hunit  >= 0.9
+    , text         >= 1.2
diff --git a/symantic/symantic.cabal b/symantic/symantic.cabal
index 8f30af1..faa16c8 100644
--- a/symantic/symantic.cabal
+++ b/symantic/symantic.cabal
@@ -79,10 +79,10 @@ Library
     Language.Symantic.Typing.Unify
     Language.Symantic.Typing.Variable
   build-depends:
-    base >= 4.6 && < 5
-    , containers
-    , mono-traversable
-    , symantic-grammar
+      symantic-grammar
     , symantic-document
-    , transformers
-    , text
+    , base             >= 4.6 && < 5
+    , containers       >= 0.5
+    , mono-traversable >= 1.0
+    , transformers     >= 0.5
+    , text             >= 1.2
-- 
2.44.1


From 73571b5f8147f9cad8735ffb32ab6c679df6738d Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 13 Feb 2018 17:01:29 +0100
Subject: [PATCH 05/16] Separate tests into test/.

---
 GNUmakefile                                   | 10 ++-
 HLint.hs                                      |  1 +
 symantic-grammar/symantic-grammar.cabal       | 16 ++--
 .../Grammar/Test.hs => test/HUnit.hs}         | 14 +---
 symantic-grammar/test/Main.hs                 | 10 +++
 .../Language/Symantic/Grammar/EBNF.hs         | 15 ----
 .../Language/Symantic/Interpreting/HLint.hs   |  1 -
 .../Symantic/Lib/Applicative/HLint.hs         |  1 -
 .../Language/Symantic/Lib/Bool/HLint.hs       |  1 -
 .../Language/Symantic/Lib/Foldable/HLint.hs   |  1 -
 .../Language/Symantic/Lib/Functor/HLint.hs    |  1 -
 .../Language/Symantic/Lib/Map/HLint.hs        |  1 -
 .../Symantic/Lib/MonoFunctor/HLint.hs         |  1 -
 .../Language/Symantic/Lib/Num/HLint.hs        |  1 -
 .../Language/Symantic/Lib/Tuple2/HLint.hs     |  1 -
 symantic-lib/Language/Symantic/Test.hs        | 14 ----
 .../Language/Symantic/Transforming/HLint.hs   |  1 -
 .../Language/Symantic/Typing/HLint.hs         |  1 -
 symantic-lib/grammar.ebnf                     | 30 ++++++++
 symantic-lib/symantic-lib.cabal               | 75 ++++---------------
 symantic-lib/test/Golden.hs                   | 46 ++++++++++++
 .../Symantic/Compiling => test}/HLint.hs      |  0
 .../Symantic/Lib/Test.hs => test/HUnit.hs}    | 39 +++++-----
 .../Test.hs => test/HUnit/Applicative.hs}     | 11 ++-
 .../Lib/Bool/Test.hs => test/HUnit/Bool.hs}   | 10 +--
 .../Test.hs => test/HUnit/Foldable.hs}        |  9 +--
 .../Functor/Test.hs => test/HUnit/Functor.hs} |  9 +--
 .../Symantic/Grammar => test/HUnit}/HLint.hs  |  0
 .../Lib/Map/Test.hs => test/HUnit/Map.hs}     |  9 +--
 .../Test.hs => test/HUnit/MonoFunctor.hs}     |  9 +--
 .../Lib/Num/Test.hs => test/HUnit/Num.hs}     |  9 +--
 .../Tuple2/Test.hs => test/HUnit/Tuple2.hs}   |  9 +--
 .../Typing/Test.hs => test/HUnit/Typing.hs}   | 18 ++---
 symantic-lib/test/Main.hs                     | 15 ++++
 .../Test.hs => test/Testing/Compiling.hs}     | 12 +--
 .../Grammar => test/Testing}/Megaparsec.hs    |  2 +-
 symantic/README.md                            | 14 ++--
 37 files changed, 211 insertions(+), 206 deletions(-)
 rename symantic-grammar/{Language/Symantic/Grammar/Test.hs => test/HUnit.hs} (95%)
 create mode 100644 symantic-grammar/test/Main.hs
 delete mode 100644 symantic-lib/Language/Symantic/Grammar/EBNF.hs
 delete mode 120000 symantic-lib/Language/Symantic/Interpreting/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Applicative/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Bool/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Foldable/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Functor/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Map/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/MonoFunctor/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Num/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Lib/Tuple2/HLint.hs
 delete mode 100644 symantic-lib/Language/Symantic/Test.hs
 delete mode 120000 symantic-lib/Language/Symantic/Transforming/HLint.hs
 delete mode 120000 symantic-lib/Language/Symantic/Typing/HLint.hs
 create mode 100644 symantic-lib/grammar.ebnf
 create mode 100644 symantic-lib/test/Golden.hs
 rename symantic-lib/{Language/Symantic/Compiling => test}/HLint.hs (100%)
 rename symantic-lib/{Language/Symantic/Lib/Test.hs => test/HUnit.hs} (52%)
 rename symantic-lib/{Language/Symantic/Lib/Applicative/Test.hs => test/HUnit/Applicative.hs} (86%)
 rename symantic-lib/{Language/Symantic/Lib/Bool/Test.hs => test/HUnit/Bool.hs} (94%)
 rename symantic-lib/{Language/Symantic/Lib/Foldable/Test.hs => test/HUnit/Foldable.hs} (86%)
 rename symantic-lib/{Language/Symantic/Lib/Functor/Test.hs => test/HUnit/Functor.hs} (86%)
 rename symantic-lib/{Language/Symantic/Grammar => test/HUnit}/HLint.hs (100%)
 rename symantic-lib/{Language/Symantic/Lib/Map/Test.hs => test/HUnit/Map.hs} (92%)
 rename symantic-lib/{Language/Symantic/Lib/MonoFunctor/Test.hs => test/HUnit/MonoFunctor.hs} (83%)
 rename symantic-lib/{Language/Symantic/Lib/Num/Test.hs => test/HUnit/Num.hs} (98%)
 rename symantic-lib/{Language/Symantic/Lib/Tuple2/Test.hs => test/HUnit/Tuple2.hs} (85%)
 rename symantic-lib/{Language/Symantic/Typing/Test.hs => test/HUnit/Typing.hs} (93%)
 create mode 100644 symantic-lib/test/Main.hs
 rename symantic-lib/{Language/Symantic/Compiling/Test.hs => test/Testing/Compiling.hs} (91%)
 rename symantic-lib/{Language/Symantic/Grammar => test/Testing}/Megaparsec.hs (99%)

diff --git a/GNUmakefile b/GNUmakefile
index 36d2a33..ead4bfd 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -8,10 +8,14 @@ build: $(PKGS:=/build)
 	cd $*; stack $(STACK_FLAGS) build $(STACK_BUILD_FLAGS)
 .PHONY: $(PKGS) $(foreach p,$(PKGS),$(eval $p: $p/build))
 
+.PHONY: $(PKGS:=/test)
 test: $(PKGS:=/test)
-%/test:
-	! grep -q '^Test-Suite\>' $*/$*.cabal || \
-	{ cd $*; stack $(STACK_FLAGS) test $(STACK_TEST_FLAGS); }
+define test
+$p/test:
+	! grep -q '^Test-Suite\>' $p/$p.cabal || \
+	{ cd $p; stack $$(STACK_FLAGS) test $$(STACK_TEST_FLAGS); }
+endef
+$(foreach p,$(PKGS),$(eval $(call test)))
 
 clean:   $(PKGS:=/clean)
 cleaner: $(PKGS:=/cleaner)
diff --git a/HLint.hs b/HLint.hs
index e1ae96d..f066509 100644
--- a/HLint.hs
+++ b/HLint.hs
@@ -1,6 +1,7 @@
 import "hint" HLint.HLint
 ignore "Redundant $"
 ignore "Redundant bracket"
+ignore "Redundant do"
 ignore "Use camelCase"
 ignore "Use import/export shortcut"
 ignore "Use fmap"
diff --git a/symantic-grammar/symantic-grammar.cabal b/symantic-grammar/symantic-grammar.cabal
index 438ef7f..034bc75 100644
--- a/symantic-grammar/symantic-grammar.cabal
+++ b/symantic-grammar/symantic-grammar.cabal
@@ -22,7 +22,7 @@ tested-with: GHC==8.2.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.3.1.20180213
+version: 0.3.0.20180213
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
@@ -73,12 +73,16 @@ Test-Suite symantic-grammar-test
     ScopedTypeVariables
     TypeFamilies
   default-language: Haskell2010
-  ghc-options: -Wall
-               -fno-warn-tabs
-               -main-is Test
-  hs-source-dirs: Language/Symantic
-  main-is: Grammar/Test.hs
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+  hs-source-dirs: test
+  main-is: Main.hs
   other-modules:
+    HUnit
   build-depends:
       symantic-grammar
     , base         >= 4.6 && < 5
diff --git a/symantic-grammar/Language/Symantic/Grammar/Test.hs b/symantic-grammar/test/HUnit.hs
similarity index 95%
rename from symantic-grammar/Language/Symantic/Grammar/Test.hs
rename to symantic-grammar/test/HUnit.hs
index dc1f719..44e6a73 100644
--- a/symantic-grammar/Language/Symantic/Grammar/Test.hs
+++ b/symantic-grammar/test/HUnit.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Test where
+module HUnit where
 
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -9,7 +9,7 @@ import Control.Applicative (Applicative(..))
 import Control.Monad
 import Data.Semigroup ((<>))
 import Data.String (IsString(..))
-import qualified Control.Applicative as Gram_AltApp
+import qualified Control.Applicative as Applicative
 import qualified Data.Char as Char
 import qualified Data.Text as Text
 import qualified Text.Megaparsec as P
@@ -34,8 +34,8 @@ instance ParsecC e s => Gram_Char (P.ParsecT e s m) where
 instance ParsecC e String => Gram_String (P.ParsecT e String m) where
 	string = P.string
 instance ParsecC e s => Gram_Alt (P.ParsecT e s m) where
-	empty  = Gram_AltApp.empty
-	(<+>)  = (Gram_AltApp.<|>)
+	empty  = Applicative.empty
+	(<+>)  = (Applicative.<|>)
 	choice = P.choice
 instance ParsecC e s => Gram_Try (P.ParsecT e s m) where
 	try = P.try
@@ -106,9 +106,3 @@ hunits = testGroup "Grammar"
 		 <*> some (string "2") ==> "{\"0\" | \"1\"}, {\"2\"}-"
 	 ]
  ]
-
-main :: IO ()
-main =
-	defaultMain $
-	testGroup "Language.Symantic"
-	 [hunits]
diff --git a/symantic-grammar/test/Main.hs b/symantic-grammar/test/Main.hs
new file mode 100644
index 0000000..b310033
--- /dev/null
+++ b/symantic-grammar/test/Main.hs
@@ -0,0 +1,10 @@
+module Main where
+
+import Test.Tasty
+import HUnit
+
+main :: IO ()
+main =
+	defaultMain $
+	testGroup "Language.Symantic"
+	 [hunits]
diff --git a/symantic-lib/Language/Symantic/Grammar/EBNF.hs b/symantic-lib/Language/Symantic/Grammar/EBNF.hs
deleted file mode 100644
index 668063d..0000000
--- a/symantic-lib/Language/Symantic/Grammar/EBNF.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Grammar.EBNF where
-
-import Data.Text.IO as Text
-import Control.Monad
-
-import Language.Symantic.Grammar
-import Language.Symantic
-import Language.Symantic.Lib ()
-
-main :: IO ()
-main = do
-	forM_ gram_comment render
-	forM_ gram_type render
-	forM_ gram_term render
-	where render = Text.putStrLn . renderEBNF . unCF
diff --git a/symantic-lib/Language/Symantic/Interpreting/HLint.hs b/symantic-lib/Language/Symantic/Interpreting/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Interpreting/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Applicative/HLint.hs b/symantic-lib/Language/Symantic/Lib/Applicative/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Applicative/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Bool/HLint.hs b/symantic-lib/Language/Symantic/Lib/Bool/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Bool/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Foldable/HLint.hs b/symantic-lib/Language/Symantic/Lib/Foldable/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Foldable/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Functor/HLint.hs b/symantic-lib/Language/Symantic/Lib/Functor/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Functor/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Map/HLint.hs b/symantic-lib/Language/Symantic/Lib/Map/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Map/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/MonoFunctor/HLint.hs b/symantic-lib/Language/Symantic/Lib/MonoFunctor/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/MonoFunctor/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Num/HLint.hs b/symantic-lib/Language/Symantic/Lib/Num/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Num/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Lib/Tuple2/HLint.hs b/symantic-lib/Language/Symantic/Lib/Tuple2/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Lib/Tuple2/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Test.hs b/symantic-lib/Language/Symantic/Test.hs
deleted file mode 100644
index 22e21e6..0000000
--- a/symantic-lib/Language/Symantic/Test.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Test where
-
-import Test.Tasty
-
-import qualified Typing.Test as Typing
-import qualified Lib.Test as Lib
-
-main :: IO ()
-main =
-	defaultMain $
-	testGroup "Language.Symantic"
-	 [ Typing.tests
-	 , Lib.tests
-	 ]
diff --git a/symantic-lib/Language/Symantic/Transforming/HLint.hs b/symantic-lib/Language/Symantic/Transforming/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Transforming/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/Language/Symantic/Typing/HLint.hs b/symantic-lib/Language/Symantic/Typing/HLint.hs
deleted file mode 120000
index ab18269..0000000
--- a/symantic-lib/Language/Symantic/Typing/HLint.hs
+++ /dev/null
@@ -1 +0,0 @@
-../HLint.hs
\ No newline at end of file
diff --git a/symantic-lib/grammar.ebnf b/symantic-lib/grammar.ebnf
new file mode 100644
index 0000000..c07dd60
--- /dev/null
+++ b/symantic-lib/grammar.ebnf
@@ -0,0 +1,30 @@
+Commentable space line block = {space | line | block} ;
+CommentLine = prefix, {_ - (↵ | eoi)} ;
+CommentBlock = begin, {_ - end}, end ;
+Lexeme g = g, Commentable (␣ | ↵, ␣) CommentLine CommentBlock ;
+Parens g = Lexeme "(", g, Lexeme ")" ;
+begin, in, end | next
+Type = TypeFun ;
+TypeFun = infixr TypeList (Lexeme "->") ;
+TypeList = Lexeme "[", (Type | ""), Lexeme "]" | TypeTuple2 ;
+TypeTuple2 = Parens (infixr Type (Lexeme ",")) | TypeApp ;
+TypeApp = {TypeAtom}- ;
+TypeAtom = Parens Type | TypeConst | TypeVar ;
+TypeConst = Lexeme ModNameTy ;
+TypeVar = Lexeme (Unicat LowercaseLetter, {Unicat_Letter | Unicat_Number}) ;
+Term = TermAbst | TermOperators | TermLet ;
+TermOperators = operators TermAtom TermPrefix TermInfix TermPostfix ;
+TermAtom = teinteger | ModNameTe | TermGroup ;
+TermGroup = Parens Term ;
+TermAbst = Lexeme "\", {TermAbstDecl}-, Lexeme "->", Term ;
+TermAbstDecl = Parens (NameTe, (Lexeme "::" | Lexeme ":"), Type) ;
+TermLet = Lexeme "let", NameTe, {TermAbstDecl}, Lexeme "=", Term, Lexeme "in", Term ;
+ModNameTe = Lexeme (ModNameTeId | Parens ModNameTeOp) ;
+NameTe = Lexeme (NameTeId | Parens NameTeOp) ;
+NameTeId = Unicat_Letter, {NameTeIdTail} - NameTeIdKey, (_ - NameTeIdTail) ;
+NameTeIdTail = Unicat_Letter | Unicat_Number ;
+NameTeIdKey = "in" | "let" ;
+ModNameTeOp = [PathMod, "."], NameTeOp ;
+NameTeOp = {NameTeOpOk}- - NameTeOpKey, (_ - NameTeOpOk) ;
+NameTeOpOk = (Unicat_Symbol | Unicat_Punctuation | Unicat_Mark) - ("(" | ")" | "`" | "'" | "," | "[" | "]") ;
+NameTeOpKey = "\" | "->" | "=" | "@" ;
diff --git a/symantic-lib/symantic-lib.cabal b/symantic-lib/symantic-lib.cabal
index 218bb36..9d2b939 100644
--- a/symantic-lib/symantic-lib.cabal
+++ b/symantic-lib/symantic-lib.cabal
@@ -114,7 +114,6 @@ Test-Suite symantic-test
     TypeOperators
   default-language: Haskell2010
   ghc-options:
-    -main-is Test
     -Wall
     -Wincomplete-uni-patterns
     -Wincomplete-record-updates
@@ -124,75 +123,33 @@ Test-Suite symantic-test
     -- -O0
     -- -fmax-simplifier-iterations=0
     -- -dshow-passes
-  hs-source-dirs: Language/Symantic
-  main-is: Test.hs
+  hs-source-dirs: test
+  main-is: Main.hs
   other-modules:
-    Compiling.Test
-    Grammar.Megaparsec
-    Lib.Applicative.Test
-    Lib.Bool.Test
-    Lib.Foldable.Test
-    Lib.Functor.Test
-    Lib.Map.Test
-    Lib.MonoFunctor.Test
-    Lib.Num.Test
-    Lib.Test
-    Lib.Tuple2.Test
-    Typing.Test
+    Golden
+    HUnit
+    HUnit.Applicative
+    HUnit.Bool
+    HUnit.Foldable
+    HUnit.Functor
+    HUnit.Map
+    HUnit.MonoFunctor
+    HUnit.Num
+    HUnit.Tuple2
+    Testing.Compiling
+    Testing.Megaparsec
   build-depends:
       symantic
     , symantic-grammar
     , symantic-lib
     , base             >= 4.6 && < 5
+    , bytestring       >= 0.10
     , containers       >= 0.5
     , megaparsec       >= 6.3
     , monad-classes    >= 0.3.2
     , mono-traversable >= 1.0
     , tasty            >= 0.11
+    , tasty-golden     >= 2.3
     , tasty-hunit      >= 0.9
     , text             >= 1.2
     , transformers     >= 0.5
-
-Test-Suite ebnf
-  type: exitcode-stdio-1.0
-  default-extensions:
-    ConstraintKinds
-    DataKinds
-    EmptyDataDecls
-    FlexibleContexts
-    FlexibleInstances
-    MultiParamTypeClasses
-    NamedFieldPuns
-    OverloadedStrings
-    PatternGuards
-    PolyKinds
-    Rank2Types
-    ScopedTypeVariables
-    StandaloneDeriving
-    TupleSections
-    TypeFamilies
-    TypeApplications
-    TypeOperators
-  ghc-options:
-    -main-is Grammar.EBNF
-    -Wall
-    -Wincomplete-uni-patterns
-    -Wincomplete-record-updates
-    -fno-warn-tabs
-    -fhide-source-paths
-    -fprint-explicit-kinds
-    -fprint-potential-instances
-  main-is: Grammar/EBNF.hs
-  default-language: Haskell2010
-  hs-source-dirs: Language/Symantic
-  build-depends:
-      symantic
-    , symantic-grammar
-    , symantic-lib
-    , base         >= 4.6 && < 5
-    , containers   >= 0.5
-    , megaparsec   >= 6.3
-    , transformers >= 0.5
-    , tasty        >= 0.11
-    , tasty-hunit  >= 0.9
-    , text         >= 1.2
diff --git a/symantic-lib/test/Golden.hs b/symantic-lib/test/Golden.hs
new file mode 100644
index 0000000..19d904e
--- /dev/null
+++ b/symantic-lib/test/Golden.hs
@@ -0,0 +1,46 @@
+module Golden where
+
+import Control.Monad (Monad(..))
+import Data.Function (($), (.))
+import Data.Functor ((<$>))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+-- import System.FilePath (FilePath)
+import System.IO (IO)
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.List as List
+import qualified Data.Text.Lazy          as TL
+import qualified Data.Text.Lazy.Encoding as TL
+
+import Test.Tasty
+import Test.Tasty.Golden
+
+import Language.Symantic.Grammar
+import Language.Symantic
+import Language.Symantic.Lib ()
+
+-- * Golden testing utilities
+testGolden :: TestName -> TestName -> IO BSL.ByteString -> TestTree
+testGolden inputFile expectedExt =
+	goldenVsStringDiff inputFile diffGolden (inputFile <> expectedExt)
+
+diffGolden :: FilePath -> FilePath -> [String]
+diffGolden ref new = ["diff", "-u", ref, new]
+
+-- * All golden tests
+goldensIO :: IO TestTree
+goldensIO = do
+	-- inputFiles <- List.sort <$> findByExtension [".sym"] "test/Golden"
+	return $
+		testGroup "Golden"
+		 [ testGolden "grammar.ebnf" "" $ do
+			return $
+				TL.encodeUtf8 $
+				TL.unlines $
+				List.concat
+				 [ render <$> gram_comment
+				 , render <$> gram_type
+				 , render <$> gram_term
+				 ]
+		 ]
+	where render = TL.fromStrict . renderEBNF . unCF
diff --git a/symantic-lib/Language/Symantic/Compiling/HLint.hs b/symantic-lib/test/HLint.hs
similarity index 100%
rename from symantic-lib/Language/Symantic/Compiling/HLint.hs
rename to symantic-lib/test/HLint.hs
diff --git a/symantic-lib/Language/Symantic/Lib/Test.hs b/symantic-lib/test/HUnit.hs
similarity index 52%
rename from symantic-lib/Language/Symantic/Lib/Test.hs
rename to symantic-lib/test/HUnit.hs
index ad901e9..2ee23b6 100644
--- a/symantic-lib/Language/Symantic/Lib/Test.hs
+++ b/symantic-lib/test/HUnit.hs
@@ -1,34 +1,33 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Test where
+module HUnit where
 
 import Test.Tasty
-
 import Prelude hiding ((&&), not, (||), id)
 
 import Language.Symantic
 import Language.Symantic.Lib
 
-import qualified Lib.Applicative.Test as Applicative
-import qualified Lib.Bool.Test as Bool
-import qualified Lib.Foldable.Test as Foldable
-import qualified Lib.Functor.Test as Functor
-import qualified Lib.Map.Test as Map
-import qualified Lib.MonoFunctor.Test as MonoFunctor
-import qualified Lib.Num.Test as Num
-import qualified Lib.Tuple2.Test as Tuple2
+import qualified HUnit.Applicative as Applicative
+import qualified HUnit.Bool        as Bool
+import qualified HUnit.Foldable    as Foldable
+import qualified HUnit.Functor     as Functor
+import qualified HUnit.Map         as Map
+import qualified HUnit.MonoFunctor as MonoFunctor
+import qualified HUnit.Num         as Num
+import qualified HUnit.Tuple2      as Tuple2
 
 -- * Tests
-tests :: TestTree
-tests = testGroup "Lib" $
- [ Applicative.tests
- , Bool.tests
- , Foldable.tests
- , Functor.tests
- , Map.tests
- , MonoFunctor.tests
- , Num.tests
- , Tuple2.tests
+hunits :: TestTree
+hunits = testGroup "HUnit" $
+ [ Applicative.hunits
+ , Bool.hunits
+ , Foldable.hunits
+ , Functor.hunits
+ , Map.hunits
+ , MonoFunctor.hunits
+ , Num.hunits
+ , Tuple2.hunits
  ]
 
 -- * EDSL tests
diff --git a/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs b/symantic-lib/test/HUnit/Applicative.hs
similarity index 86%
rename from symantic-lib/Language/Symantic/Lib/Applicative/Test.hs
rename to symantic-lib/test/HUnit/Applicative.hs
index 5e2153e..1cfea31 100644
--- a/symantic-lib/Language/Symantic/Lib/Applicative/Test.hs
+++ b/symantic-lib/test/HUnit/Applicative.hs
@@ -1,13 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Applicative.Test where
+module HUnit.Applicative where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 
 import Language.Symantic.Lib
-import Compiling.Test
-import Lib.Bool.Test ()
+import Testing.Compiling
+import HUnit.Bool ()
 
 type SS =
  [ Proxy (->)
@@ -19,8 +18,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Applicative"
+hunits :: TestTree
+hunits = testGroup "Applicative"
  [ "Just (xor True) <*> Just True"    ==> Right (tyMaybe tyBool, Just False, "Just (\\x0 -> True `xor` x0) <*> Just True")
  , "Just (xor True) <*> Nothing"      ==> Right (tyMaybe tyBool, Nothing   , "Just (\\x0 -> True `xor` x0) <*> Nothing")
  , "xor <$> Just True <*> Just False" ==> Right (tyMaybe tyBool, Just True , "(\\x0 -> (\\x1 -> x0 `xor` x1)) <$> Just True <*> Just False")
diff --git a/symantic-lib/Language/Symantic/Lib/Bool/Test.hs b/symantic-lib/test/HUnit/Bool.hs
similarity index 94%
rename from symantic-lib/Language/Symantic/Lib/Bool/Test.hs
rename to symantic-lib/test/HUnit/Bool.hs
index 2ebe202..b2fca18 100644
--- a/symantic-lib/Language/Symantic/Lib/Bool/Test.hs
+++ b/symantic-lib/test/HUnit/Bool.hs
@@ -1,15 +1,13 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Bool.Test where
+module HUnit.Bool where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 import Prelude hiding ((&&), not, (||))
 
 import Language.Symantic
 import Language.Symantic.Lib
--- import Language.Symantic.Lib.Lambda ((~>))
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy Bool
@@ -20,8 +18,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Bool" $
+hunits :: TestTree
+hunits = testGroup "Bool" $
  [ "True"                           ==> Right (tyBool, True , "True")
  , "xor True True"                  ==> Right (tyBool, False, "True `xor` True")
  , "xor False True"                 ==> Right (tyBool, True , "False `xor` True")
diff --git a/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs b/symantic-lib/test/HUnit/Foldable.hs
similarity index 86%
rename from symantic-lib/Language/Symantic/Lib/Foldable/Test.hs
rename to symantic-lib/test/HUnit/Foldable.hs
index 82b406c..818408f 100644
--- a/symantic-lib/Language/Symantic/Lib/Foldable/Test.hs
+++ b/symantic-lib/test/HUnit/Foldable.hs
@@ -1,12 +1,11 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Foldable.Test where
+module HUnit.Foldable where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy (->)
@@ -19,8 +18,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Foldable"
+hunits :: TestTree
+hunits = testGroup "Foldable"
  [ {-"[]" ==> Right (tyList (tyVar "a" varZ), [], "[]")
  ,-} "[1, 2, 3]" ==> Right (tyList tyInteger, [1, 2, 3], "1 : 2 : 3 : []")
  , "1 : 2 : 3 : []" ==> Right (tyList tyInteger, [1, 2, 3], "1 : 2 : 3 : []")
diff --git a/symantic-lib/Language/Symantic/Lib/Functor/Test.hs b/symantic-lib/test/HUnit/Functor.hs
similarity index 86%
rename from symantic-lib/Language/Symantic/Lib/Functor/Test.hs
rename to symantic-lib/test/HUnit/Functor.hs
index 508e7eb..c191e30 100644
--- a/symantic-lib/Language/Symantic/Lib/Functor/Test.hs
+++ b/symantic-lib/test/HUnit/Functor.hs
@@ -1,13 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Functor.Test where
+module HUnit.Functor where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 
 import Language.Symantic ()
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy (->)
@@ -18,8 +17,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Functor"
+hunits :: TestTree
+hunits = testGroup "Functor"
  [ "fmap not (Just True)" ==> Right (tyMaybe tyBool, Just False, "fmap (\\x0 -> not x0) (Just True)")
  , "not `fmap` Just True" ==> Right (tyMaybe tyBool, Just False, "fmap (\\x0 -> not x0) (Just True)")
  , "not <$> Just True"    ==> Right (tyMaybe tyBool, Just False, "(\\x0 -> not x0) <$> Just True")
diff --git a/symantic-lib/Language/Symantic/Grammar/HLint.hs b/symantic-lib/test/HUnit/HLint.hs
similarity index 100%
rename from symantic-lib/Language/Symantic/Grammar/HLint.hs
rename to symantic-lib/test/HUnit/HLint.hs
diff --git a/symantic-lib/Language/Symantic/Lib/Map/Test.hs b/symantic-lib/test/HUnit/Map.hs
similarity index 92%
rename from symantic-lib/Language/Symantic/Lib/Map/Test.hs
rename to symantic-lib/test/HUnit/Map.hs
index ff112e2..c8b08ce 100644
--- a/symantic-lib/Language/Symantic/Lib/Map/Test.hs
+++ b/symantic-lib/test/HUnit/Map.hs
@@ -1,15 +1,14 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Map.Test where
+module HUnit.Map where
 
 import Test.Tasty
-
 import Data.Map.Strict (Map)
 import Data.Proxy (Proxy(..))
 import Data.Text as Text
 import qualified Data.Map.Strict as Map
 
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy (->)
@@ -24,8 +23,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Map"
+hunits :: TestTree
+hunits = testGroup "Map"
  [ "Map.fromList (zipWith (,) [1, 2, 3] ['a', 'b', 'c'])" ==> Right
 	 ( tyMap tyInteger tyChar
 	 , Map.fromList [(1, 'a'), (2, 'b'), (3, 'c')]
diff --git a/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs b/symantic-lib/test/HUnit/MonoFunctor.hs
similarity index 83%
rename from symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs
rename to symantic-lib/test/HUnit/MonoFunctor.hs
index 11a5784..ee1774d 100644
--- a/symantic-lib/Language/Symantic/Lib/MonoFunctor/Test.hs
+++ b/symantic-lib/test/HUnit/MonoFunctor.hs
@@ -1,13 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.MonoFunctor.Test where
+module HUnit.MonoFunctor where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 import qualified Data.MonoTraversable as MT
 
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy (->)
@@ -20,8 +19,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "MonoFunctor"
+hunits :: TestTree
+hunits = testGroup "MonoFunctor"
  [ "omap not (Just True)" ==> Right (tyMaybe tyBool, Just False, "omap (\\x0 -> not x0) (Just True)")
  , "omap Char.toUpper ['a', 'b', 'c']" ==> Right (tyList tyChar, "ABC", "omap (\\x0 -> Char.toUpper x0) ('a' : 'b' : 'c' : [])" )
  ]
diff --git a/symantic-lib/Language/Symantic/Lib/Num/Test.hs b/symantic-lib/test/HUnit/Num.hs
similarity index 98%
rename from symantic-lib/Language/Symantic/Lib/Num/Test.hs
rename to symantic-lib/test/HUnit/Num.hs
index 0a1d1e8..cd72c71 100644
--- a/symantic-lib/Language/Symantic/Lib/Num/Test.hs
+++ b/symantic-lib/test/HUnit/Num.hs
@@ -1,16 +1,15 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Lib.Num.Test where
+module HUnit.Num where
 
 import Test.Tasty
-
 import Prelude (Num)
 import Prelude hiding (Num(..))
 
 import Language.Symantic
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 -- * Tests
 type SS =
@@ -26,8 +25,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Num"
+hunits :: TestTree
+hunits = testGroup "Num"
  [ "42"                        ==> Right (tyInteger,  42, "42")
  , "-42"                       ==> Right (tyInteger, -42, "negate 42")
  , "- -42"                     ==> Right (tyInteger,  42, "negate (negate 42)")
diff --git a/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs b/symantic-lib/test/HUnit/Tuple2.hs
similarity index 85%
rename from symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs
rename to symantic-lib/test/HUnit/Tuple2.hs
index 348f056..caa0877 100644
--- a/symantic-lib/Language/Symantic/Lib/Tuple2/Test.hs
+++ b/symantic-lib/test/HUnit/Tuple2.hs
@@ -1,12 +1,11 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Lib.Tuple2.Test where
+module HUnit.Tuple2 where
 
 import Test.Tasty
-
 import Data.Proxy (Proxy(..))
 
 import Language.Symantic.Lib
-import Compiling.Test
+import Testing.Compiling
 
 type SS =
  [ Proxy (->)
@@ -16,8 +15,8 @@ type SS =
  ]
 (==>) = readTe @() @SS
 
-tests :: TestTree
-tests = testGroup "Tuple2"
+hunits :: TestTree
+hunits = testGroup "Tuple2"
  [ "()"             ==> Right (tyUnit, (), "()")
  , "(,) 1 2"        ==> Right (tyTuple2 tyInteger tyInteger, (1,2), "(1, 2)")
  , "(1,2)"          ==> Right (tyTuple2 tyInteger tyInteger, (1,2), "(1, 2)")
diff --git a/symantic-lib/Language/Symantic/Typing/Test.hs b/symantic-lib/test/HUnit/Typing.hs
similarity index 93%
rename from symantic-lib/Language/Symantic/Typing/Test.hs
rename to symantic-lib/test/HUnit/Typing.hs
index 7033170..25d8707 100644
--- a/symantic-lib/Language/Symantic/Typing/Test.hs
+++ b/symantic-lib/test/HUnit/Typing.hs
@@ -1,8 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Typing.Test where
+module HUnit.Typing where
 
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -21,7 +17,7 @@ import Data.Void (Void)
 import GHC.Exts (Constraint)
 import Prelude hiding (exp)
 import qualified Control.Monad.Classes.Run as MC
-import qualified Control.Monad.Trans.State.Strict as SS
+import qualified Control.Monad.Trans.State.Strict as S
 import qualified Data.Function as Fun
 import qualified Data.Map.Strict as Map
 import qualified Data.MonoTraversable as MT
@@ -33,9 +29,9 @@ import Language.Symantic.Grammar
 import Language.Symantic
 import Language.Symantic.Lib hiding ((<$>), (<*))
 
-import Grammar.Megaparsec ()
+import Testing.Megaparsec ()
+import Testing.Typing
 
--- * Tests
 type SS =
  [ Proxy (->)
  , Proxy Bool
@@ -89,7 +85,7 @@ modsTy =
 
 parseTy ::
  forall src g err inp.
- g ~ P.ParsecT err inp (SS.StateT (Imports NameTy, ModulesTy src) Identity) =>
+ g ~ P.ParsecT err inp (S.StateT (Imports NameTy, ModulesTy src) Identity) =>
  P.MonadParsec err inp (P.ParsecT err inp g) =>
  Gram_Type src g =>
  P.Token inp ~ Char =>
@@ -100,8 +96,8 @@ parseTy inp =
 	P.runParserT g "" inp
 	where g = unCF $ g_type <* eoi
 
-tests :: TestTree
-tests = testGroup "Typing" $
+hunits :: TestTree
+hunits = testGroup "Typing" $
  [ testGroup "readType" $
 	let run inp (TypeT exp :: TypeT SRC '[]) =
 		testCase inp $ got @?= Right (Right $ TypeVT exp)
diff --git a/symantic-lib/test/Main.hs b/symantic-lib/test/Main.hs
new file mode 100644
index 0000000..c398382
--- /dev/null
+++ b/symantic-lib/test/Main.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Test.Tasty
+
+import Golden
+import HUnit
+
+main :: IO ()
+main = do
+	goldens <- goldensIO
+	defaultMain $
+		testGroup "Symantic"
+		 [ goldens
+		 , hunits
+		 ]
diff --git a/symantic-lib/Language/Symantic/Compiling/Test.hs b/symantic-lib/test/Testing/Compiling.hs
similarity index 91%
rename from symantic-lib/Language/Symantic/Compiling/Test.hs
rename to symantic-lib/test/Testing/Compiling.hs
index 033349f..8fb5411 100644
--- a/symantic-lib/Language/Symantic/Compiling/Test.hs
+++ b/symantic-lib/test/Testing/Compiling.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Compiling.Test where
+module Testing.Compiling where
 
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -15,7 +15,7 @@ import Data.Text (Text)
 import Data.Type.Equality
 import Data.Void (Void)
 import qualified Control.Monad.Classes.Run as MC
-import qualified Control.Monad.Trans.State.Strict as SS
+import qualified Control.Monad.Trans.State.Strict as S
 import qualified Data.List as List
 import qualified Data.Text as Text
 import qualified Text.Megaparsec as P
@@ -24,13 +24,13 @@ import Language.Symantic.Grammar
 import Language.Symantic
 import Language.Symantic.Lib ()
 
-import Grammar.Megaparsec ()
+import Testing.Megaparsec ()
 
 type G src ss =
  P.ParsecT Void Text
-           (SS.StateT (Imports NameTe, Modules src ss)
-                      ((SS.StateT (Imports NameTy, ModulesTy src))
-                                  Identity))
+           (S.StateT (Imports NameTe, Modules src ss)
+                     ((S.StateT (Imports NameTy, ModulesTy src))
+                                Identity))
 
 parseTe ::
  forall ss src.
diff --git a/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs b/symantic-lib/test/Testing/Megaparsec.hs
similarity index 99%
rename from symantic-lib/Language/Symantic/Grammar/Megaparsec.hs
rename to symantic-lib/test/Testing/Megaparsec.hs
index 2e50260..8cc8b8b 100644
--- a/symantic-lib/Language/Symantic/Grammar/Megaparsec.hs
+++ b/symantic-lib/test/Testing/Megaparsec.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- | Symantic instances for Megaparsec
-module Grammar.Megaparsec where
+module Testing.Megaparsec where
 
 import Control.Applicative (Applicative(..))
 import Control.Monad (Monad(..))
diff --git a/symantic/README.md b/symantic/README.md
index 226c757..4be1aee 100644
--- a/symantic/README.md
+++ b/symantic/README.md
@@ -65,14 +65,12 @@ and a controlled environment of primitives.
 
 # Usage
 
-Please pick in [symantic-lib](https://hackage.haskell.org/package/symantic-lib)
-a few specific `Lib/*.hs` files near what you want to do
-and the corresponding `Lib/*/Test.hs` file,
-if any in the [Git repository](git://git.autogeree.net/symantic),
-to learn by examples how to use this library.
-
-Those `Lib/*/Test.hs` files use [megaparsec](https://hackage.haskell.org/package/megaparsec) as parser
-(see `Grammar/Megaparsec.hs`) and a default grammar somehow sticking to Haskell's,
+Please learn how to use this library by reading example source files in `test/`
+in [symantic-lib](https://hackage.haskell.org/package/symantic-lib)
+in [Git repository](git://git.autogeree.net/symantic).
+
+These `test` files use [megaparsec](https://hackage.haskell.org/package/megaparsec) as parser
+(see `test/Testing/Megaparsec.hs`) and a default grammar somehow sticking to Haskell's,
 but staying context-free (so in particular: insensitive to the indentation),
 and supporting prefix and postfix operators.
 This grammar — itself written as a symantic embedded DSL
-- 
2.44.1


From d76fdc2db551d3dc21ff6d23782fd09e89250212 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 13 Feb 2018 23:21:36 +0100
Subject: [PATCH 06/16] Remove unused dependencies.

---
 symantic-lib/symantic-lib.cabal | 2 --
 1 file changed, 2 deletions(-)

diff --git a/symantic-lib/symantic-lib.cabal b/symantic-lib/symantic-lib.cabal
index 9d2b939..ef42365 100644
--- a/symantic-lib/symantic-lib.cabal
+++ b/symantic-lib/symantic-lib.cabal
@@ -92,8 +92,6 @@ Library
     , symantic-grammar
     , base             >= 4.6 && < 5
     , containers       >= 0.5
-    , ghc-prim         >= 0.5
-    , monad-classes    >= 0.3.2
     , mono-traversable >= 1.0
     , transformers     >= 0.5
     , text             >= 1.2
-- 
2.44.1


From 03e0aa4dc2d9600011ac84df7692aa0ae456483a Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Wed, 14 Feb 2018 00:30:38 +0100
Subject: [PATCH 07/16] Massage .cabal files.

---
 symantic-document/symantic-document.cabal |  53 +++++-----
 symantic-grammar/symantic-grammar.cabal   |  78 +++++++--------
 symantic-lib/symantic-lib.cabal           | 114 +++++++++++-----------
 symantic/symantic.cabal                   |  78 +++++++--------
 4 files changed, 165 insertions(+), 158 deletions(-)

diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index e3386e9..36ee488 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -1,33 +1,41 @@
-author: Julien Moutinho <julm+symantic@autogeree.net>
--- bug-reports: http://bug.autogeree.net/symantic
-build-type: Simple
-cabal-version: >= 1.8
+name: symantic-document
+-- PVP:  +-+------- breaking API changes
+--       | | +----- non-breaking API additions
+--       | | | +--- code changes with no API change
+version: 0.0.0.20180213
 category: Text
--- data-dir: data
--- data-files: 
+synopsis: Document symantics.
 description: Symantics for generating documents.
-extra-source-files:
-  stack.yaml
-extra-tmp-files:
--- homepage: http://pad.autogeree.net/informatique/symantic
+extra-doc-files:
 license: GPL-3
 license-file: COPYING
-maintainer: Julien Moutinho <julm+symantic@autogeree.net>
-name: symantic-document
 stability: experimental
-synopsis: Document symantics.
-tested-with: GHC==8.0.2
--- PVP:  +-+------- breaking API changes
---       | | +----- non-breaking API additions
---       | | | +--- code changes with no API change
-version: 0.0.0.20170623
+author:      Julien Moutinho <julm+symantic@autogeree.net>
+maintainer:  Julien Moutinho <julm+symantic@autogeree.net>
+bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
+-- homepage:
+
+build-type: Simple
+cabal-version: >= 1.10
+tested-with: GHC==8.2.2
+extra-source-files:
+  stack.yaml
+extra-tmp-files:
 
 source-repository head
   location: git://git.autogeree.net/symantic
   type:     git
 
 Library
-  extensions:
+  exposed-modules:
+    Language.Symantic.Document
+    Language.Symantic.Document.ANSI
+    Language.Symantic.Document.Dim
+    Language.Symantic.Document.Plain
+    Language.Symantic.Document.Sym
+    Language.Symantic.Document.Valid
+  default-language: Haskell2010
+  default-extensions:
     NoImplicitPrelude
     DataKinds
     DefaultSignatures
@@ -48,13 +56,6 @@ Library
     -Wincomplete-record-updates
     -fno-warn-tabs
     -fhide-source-paths
-  exposed-modules:
-    Language.Symantic.Document
-    Language.Symantic.Document.ANSI
-    Language.Symantic.Document.Dim
-    Language.Symantic.Document.Plain
-    Language.Symantic.Document.Sym
-    Language.Symantic.Document.Valid
   build-depends:
       ansi-terminal >= 0.7
     , base          >= 4.6 && < 5
diff --git a/symantic-grammar/symantic-grammar.cabal b/symantic-grammar/symantic-grammar.cabal
index 034bc75..d1f5e77 100644
--- a/symantic-grammar/symantic-grammar.cabal
+++ b/symantic-grammar/symantic-grammar.cabal
@@ -1,34 +1,49 @@
-author: Julien Moutinho <julm+symantic@autogeree.net>
-bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
-build-type: Simple
-cabal-version: >= 1.24
-category: Language
-description:
-  This library defines an embedded DSL for regular or context-free grammars,
-  in the <http://okmij.org/ftp/tagless-final/ Tagless-Final> way (aka. the /symantic/ way).
-  .
-  See @Test.hs@ or source code of <https://hackage.haskell.org/package/symantic symantic>
-  and <https://hackage.haskell.org/package/symantic-lib symantic-lib> for examples of use.
-extra-source-files:
-extra-tmp-files:
--- homepage: 
-license: GPL-3
-license-file: COPYING
-maintainer: Julien Moutinho <julm+symantic@autogeree.net>
 name: symantic-grammar
-stability: experimental
-synopsis: Library for symantic grammars.
-tested-with: GHC==8.2.2
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
 version: 0.3.0.20180213
+category: Language
+synopsis: Library for symantic grammars.
+description: This library defines an embedded DSL for regular or context-free grammars,
+             in the <http://okmij.org/ftp/tagless-final/ Tagless-Final> way (aka. the /symantic/ way).
+             .
+             See @Test.hs@ or source code of <https://hackage.haskell.org/package/symantic symantic>
+             and <https://hackage.haskell.org/package/symantic-lib symantic-lib> for examples of use.
+extra-doc-files:
+license: GPL-3
+license-file: COPYING
+stability: experimental
+author:      Julien Moutinho <julm+symantic@autogeree.net>
+maintainer:  Julien Moutinho <julm+symantic@autogeree.net>
+bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
+-- homepage:
+
+build-type: Simple
+cabal-version: >= 1.24
+tested-with: GHC==8.2.2
+extra-source-files:
+  stack.yaml
+extra-tmp-files:
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
   type:     git
 
 Library
+  exposed-modules:
+    Language.Symantic.Grammar
+    Language.Symantic.Grammar.BinTree
+    Language.Symantic.Grammar.ContextFree
+    Language.Symantic.Grammar.EBNF
+    Language.Symantic.Grammar.Fixity
+    Language.Symantic.Grammar.Meta
+    Language.Symantic.Grammar.Operators
+    Language.Symantic.Grammar.Regular
+    Language.Symantic.Grammar.Terminal
+    Language.Symantic.Grammar.Source
+    Language.Symantic.Grammar.Error
+  default-language: Haskell2010
   default-extensions:
     DataKinds
     FlexibleContexts
@@ -46,25 +61,17 @@ Library
     -Wincomplete-record-updates
     -fno-warn-tabs
     -fhide-source-paths
-  default-language: Haskell2010
-  exposed-modules:
-    Language.Symantic.Grammar
-    Language.Symantic.Grammar.BinTree
-    Language.Symantic.Grammar.ContextFree
-    Language.Symantic.Grammar.EBNF
-    Language.Symantic.Grammar.Fixity
-    Language.Symantic.Grammar.Meta
-    Language.Symantic.Grammar.Operators
-    Language.Symantic.Grammar.Regular
-    Language.Symantic.Grammar.Terminal
-    Language.Symantic.Grammar.Source
-    Language.Symantic.Grammar.Error
   build-depends:
       base >= 4.6 && < 5
     , text >= 1.2
 
 Test-Suite symantic-grammar-test
   type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  other-modules:
+    HUnit
+  default-language: Haskell2010
   default-extensions:
     FlexibleContexts
     FlexibleInstances
@@ -72,17 +79,12 @@ Test-Suite symantic-grammar-test
     OverloadedStrings
     ScopedTypeVariables
     TypeFamilies
-  default-language: Haskell2010
   ghc-options:
     -Wall
     -Wincomplete-uni-patterns
     -Wincomplete-record-updates
     -fno-warn-tabs
     -fhide-source-paths
-  hs-source-dirs: test
-  main-is: Main.hs
-  other-modules:
-    HUnit
   build-depends:
       symantic-grammar
     , base         >= 4.6 && < 5
diff --git a/symantic-lib/symantic-lib.cabal b/symantic-lib/symantic-lib.cabal
index ef42365..f2bbc24 100644
--- a/symantic-lib/symantic-lib.cabal
+++ b/symantic-lib/symantic-lib.cabal
@@ -1,55 +1,33 @@
-author: Julien Moutinho <julm+symantic@autogeree.net>
+name: symantic-lib
+-- PVP:  +-+------- breaking API changes
+--       | | +----- non-breaking API additions
+--       | | | +--- code changes with no API change
+version: 0.0.3.20180213
+category: Language
+synopsis: Symantics for common types.
+description: Symantics for common types,
+             using <https://hackage.haskell.org/package/symantic symantic>.
+extra-doc-files:
+license: GPL-3
+license-file: COPYING
+stability: experimental
+author:      Julien Moutinho <julm+symantic@autogeree.net>
+maintainer:  Julien Moutinho <julm+symantic@autogeree.net>
 bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
+-- homepage:
+
 build-type: Simple
 cabal-version: >= 1.24
-category: Language
-description:
-  Symantics for common types,
-  using <https://hackage.haskell.org/package/symantic symantic>.
 extra-source-files:
+  stack.yaml
 extra-tmp-files:
--- homepage: 
-license: GPL-3
-license-file: COPYING
-maintainer: Julien Moutinho <julm+symantic@autogeree.net>
-name: symantic-lib
-stability: experimental
-synopsis: Symantics for common types.
 tested-with: GHC==8.2.2
--- PVP:  +-+------- breaking API changes
---       | | +----- non-breaking API additions
---       | | | +--- code changes with no API change
-version: 0.0.3.20180213
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
   type:     git
 
 Library
-  default-extensions:
-    DataKinds
-    DefaultSignatures
-    FlexibleContexts
-    FlexibleInstances
-    LambdaCase
-    MultiParamTypeClasses
-    NamedFieldPuns
-    OverloadedStrings
-    Rank2Types
-    ScopedTypeVariables
-    StandaloneDeriving
-    TupleSections
-    TypeApplications
-    TypeFamilies
-    TypeOperators
-  ghc-options:
-    -Wall
-    -Wincomplete-uni-patterns
-    -Wincomplete-record-updates
-    -fno-warn-tabs
-    -fhide-source-paths
-    -fprint-explicit-kinds
-  default-language: Haskell2010
   exposed-modules:
     Language.Symantic.Lib
     Language.Symantic.Lib.Alternative
@@ -87,30 +65,23 @@ Library
     Language.Symantic.Lib.Traversable
     Language.Symantic.Lib.Tuple2
     Language.Symantic.Lib.Unit
-  build-depends:
-      symantic
-    , symantic-grammar
-    , base             >= 4.6 && < 5
-    , containers       >= 0.5
-    , mono-traversable >= 1.0
-    , transformers     >= 0.5
-    , text             >= 1.2
-
-Test-Suite symantic-test
-  type: exitcode-stdio-1.0
+  default-language: Haskell2010
   default-extensions:
     DataKinds
+    DefaultSignatures
     FlexibleContexts
     FlexibleInstances
+    LambdaCase
     MultiParamTypeClasses
-    NoMonomorphismRestriction
+    NamedFieldPuns
     OverloadedStrings
+    Rank2Types
     ScopedTypeVariables
+    StandaloneDeriving
     TupleSections
     TypeApplications
     TypeFamilies
     TypeOperators
-  default-language: Haskell2010
   ghc-options:
     -Wall
     -Wincomplete-uni-patterns
@@ -118,9 +89,17 @@ Test-Suite symantic-test
     -fno-warn-tabs
     -fhide-source-paths
     -fprint-explicit-kinds
-    -- -O0
-    -- -fmax-simplifier-iterations=0
-    -- -dshow-passes
+  build-depends:
+      symantic
+    , symantic-grammar
+    , base             >= 4.6 && < 5
+    , containers       >= 0.5
+    , mono-traversable >= 1.0
+    , transformers     >= 0.5
+    , text             >= 1.2
+
+Test-Suite symantic-test
+  type: exitcode-stdio-1.0
   hs-source-dirs: test
   main-is: Main.hs
   other-modules:
@@ -136,6 +115,29 @@ Test-Suite symantic-test
     HUnit.Tuple2
     Testing.Compiling
     Testing.Megaparsec
+  default-language: Haskell2010
+  default-extensions:
+    DataKinds
+    FlexibleContexts
+    FlexibleInstances
+    MultiParamTypeClasses
+    NoMonomorphismRestriction
+    OverloadedStrings
+    ScopedTypeVariables
+    TupleSections
+    TypeApplications
+    TypeFamilies
+    TypeOperators
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+    -fprint-explicit-kinds
+    -- -O0
+    -- -fmax-simplifier-iterations=0
+    -- -dshow-passes
   build-depends:
       symantic
     , symantic-grammar
diff --git a/symantic/symantic.cabal b/symantic/symantic.cabal
index faa16c8..fdc08cb 100644
--- a/symantic/symantic.cabal
+++ b/symantic/symantic.cabal
@@ -1,56 +1,35 @@
-author: Julien Moutinho <julm+symantic@autogeree.net>
-bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
-build-type: Simple
-cabal-version: >= 1.24
-category: Language
+name: symantic
+-- PVP:  +-+------- breaking API changes
+--       | | +----- non-breaking API additions
+--       | | | +--- code changes with no API change
+version: 6.3.1.20180213
+synopsis: Library for Typed Tagless-Final Higher-Order Composable DSL
 description: This is an experimental library for composing, parsing,
              typing, compiling, transforming and interpreting
              a custom DSL (Domain-Specific Language)
              expressing a subset of GHC's Haskell type system.
 extra-doc-files: README.md
-extra-source-files:
-extra-tmp-files:
--- homepage: 
+category: Language
 license: GPL-3
 license-file: COPYING
-maintainer: Julien Moutinho <julm+symantic@autogeree.net>
-name: symantic
 stability: experimental
-synopsis: Library for Typed Tagless-Final Higher-Order Composable DSL
+author:      Julien Moutinho <julm+symantic@autogeree.net>
+maintainer:  Julien Moutinho <julm+symantic@autogeree.net>
+bug-reports: Julien Moutinho <julm+symantic@autogeree.net>
+-- homepage:
+
+build-type: Simple
+cabal-version: >= 1.24
 tested-with: GHC==8.2.2
--- PVP:  +-+------- breaking API changes
---       | | +----- non-breaking API additions
---       | | | +--- code changes with no API change
-version: 6.3.1.20180213
+extra-source-files:
+  stack.yaml
+extra-tmp-files:
 
 Source-Repository head
   location: git://git.autogeree.net/symantic
   type:     git
 
 Library
-  default-extensions:
-    DataKinds
-    DefaultSignatures
-    FlexibleContexts
-    FlexibleInstances
-    LambdaCase
-    MultiParamTypeClasses
-    NamedFieldPuns
-    OverloadedStrings
-    Rank2Types
-    ScopedTypeVariables
-    StandaloneDeriving
-    TupleSections
-    TypeApplications
-    TypeFamilies
-    TypeOperators
-  ghc-options:
-    -Wall
-    -Wincomplete-uni-patterns
-    -Wincomplete-record-updates
-    -fno-warn-tabs
-    -fhide-source-paths
-  default-language: Haskell2010
   exposed-modules:
     Language.Symantic
     Language.Symantic.Compiling
@@ -78,6 +57,29 @@ Library
     Language.Symantic.Typing.Type
     Language.Symantic.Typing.Unify
     Language.Symantic.Typing.Variable
+  default-language: Haskell2010
+  default-extensions:
+    DataKinds
+    DefaultSignatures
+    FlexibleContexts
+    FlexibleInstances
+    LambdaCase
+    MultiParamTypeClasses
+    NamedFieldPuns
+    OverloadedStrings
+    Rank2Types
+    ScopedTypeVariables
+    StandaloneDeriving
+    TupleSections
+    TypeApplications
+    TypeFamilies
+    TypeOperators
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
   build-depends:
       symantic-grammar
     , symantic-document
-- 
2.44.1


From c03ef0b6c31799e961569209ef1596fa1b374b30 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Mon, 5 Mar 2018 05:22:20 +0100
Subject: [PATCH 08/16] Add Doc_Align and Doc_Wrap.

---
 .../Language/Symantic/Document.hs             |   2 -
 .../Language/Symantic/Document/ANSI.hs        | 162 ------------
 .../Language/Symantic/Document/Dim.hs         | 107 +++++---
 .../Language/Symantic/Document/Plain.hs       | 245 +++++++++++++-----
 .../Language/Symantic/Document/Sym.hs         | 129 ++++++---
 symantic-document/symantic-document.cabal     |  44 +++-
 symantic-document/test/HUnit.hs               | 111 ++++++++
 symantic-document/test/Main.hs                |  14 +
 8 files changed, 503 insertions(+), 311 deletions(-)
 delete mode 100644 symantic-document/Language/Symantic/Document/ANSI.hs
 create mode 100644 symantic-document/test/HUnit.hs
 create mode 100644 symantic-document/test/Main.hs

diff --git a/symantic-document/Language/Symantic/Document.hs b/symantic-document/Language/Symantic/Document.hs
index 3812878..d7f19bd 100644
--- a/symantic-document/Language/Symantic/Document.hs
+++ b/symantic-document/Language/Symantic/Document.hs
@@ -1,13 +1,11 @@
 module Language.Symantic.Document
  ( module Language.Symantic.Document.Sym
- , module Language.Symantic.Document.ANSI
  , module Language.Symantic.Document.Dim
  , module Language.Symantic.Document.Plain
  , module Language.Symantic.Document.Valid
  ) where
 
 import Language.Symantic.Document.Sym
-import Language.Symantic.Document.ANSI
 import Language.Symantic.Document.Dim
 import Language.Symantic.Document.Plain
 import Language.Symantic.Document.Valid
diff --git a/symantic-document/Language/Symantic/Document/ANSI.hs b/symantic-document/Language/Symantic/Document/ANSI.hs
deleted file mode 100644
index 704657b..0000000
--- a/symantic-document/Language/Symantic/Document/ANSI.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-module Language.Symantic.Document.ANSI where
-
-import Control.Monad (Monad(..), replicateM_)
-import Data.Bool (Bool(..))
-import Data.Function (($), (.), const)
-import Data.Monoid (Monoid(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (IsString(..))
-import System.Console.ANSI
-import System.IO (IO)
-import Text.Show (Show(..))
-import qualified Data.List as L
-import qualified Data.Text.IO as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TLB
-import qualified Data.Text.Lazy.IO as TL
-import qualified System.IO as IO
-
-import Language.Symantic.Document.Sym
-
--- * Type 'ANSI'
-newtype ANSI = ANSI { unANSI :: [SGR] -> TLB.Builder }
-instance IsString ANSI where
-	fromString s = ANSI $ const t
-		where t = fromString s
-
-ansi :: ANSI -> TLB.Builder
-ansi (ANSI d) = d []
-
-pushSGR :: SGR -> ANSI -> ANSI
-pushSGR c (ANSI d) = ANSI $ \cs ->
-	fromString (setSGRCode [c]) <>
-	d (c:cs) <>
-	fromString (setSGRCode $ Reset:L.reverse cs)
-
-instance Semigroup ANSI where
-	ANSI x <> ANSI y = ANSI $ \c -> x c <> y c
-instance Monoid ANSI where
-	mempty  = empty
-	mappend = (<>)
-instance Doc_Text ANSI where
-	replicate i d = ANSI $ TLB.fromLazyText . TL.replicate (int64OfInt i) . TLB.toLazyText . unANSI d
-	int     = ANSI . const . fromString . show
-	integer = ANSI . const . fromString . show
-	char    = ANSI . const . TLB.singleton
-	string  = ANSI . const . fromString
-	text    = ANSI . const . TLB.fromText
-	ltext   = ANSI . const . TLB.fromLazyText
-	charH   = char
-	stringH = string
-	textH   = text
-	ltextH  = ltext
-instance Doc_Color ANSI where
-	reverse     = pushSGR $ SetSwapForegroundBackground True
-	black       = pushSGR $ SetColor Foreground Dull  Black
-	red         = pushSGR $ SetColor Foreground Dull  Red
-	green       = pushSGR $ SetColor Foreground Dull  Green
-	yellow      = pushSGR $ SetColor Foreground Dull  Yellow
-	blue        = pushSGR $ SetColor Foreground Dull  Blue
-	magenta     = pushSGR $ SetColor Foreground Dull  Magenta
-	cyan        = pushSGR $ SetColor Foreground Dull  Cyan
-	white       = pushSGR $ SetColor Foreground Dull  White
-	blacker     = pushSGR $ SetColor Foreground Vivid Black
-	redder      = pushSGR $ SetColor Foreground Vivid Red
-	greener     = pushSGR $ SetColor Foreground Vivid Green
-	yellower    = pushSGR $ SetColor Foreground Vivid Yellow
-	bluer       = pushSGR $ SetColor Foreground Vivid Blue
-	magentaer   = pushSGR $ SetColor Foreground Vivid Magenta
-	cyaner      = pushSGR $ SetColor Foreground Vivid Cyan
-	whiter      = pushSGR $ SetColor Foreground Vivid White
-	onBlack     = pushSGR $ SetColor Background Dull  Black
-	onRed       = pushSGR $ SetColor Background Dull  Red
-	onGreen     = pushSGR $ SetColor Background Dull  Green
-	onYellow    = pushSGR $ SetColor Background Dull  Yellow
-	onBlue      = pushSGR $ SetColor Background Dull  Blue
-	onMagenta   = pushSGR $ SetColor Background Dull  Magenta
-	onCyan      = pushSGR $ SetColor Background Dull  Cyan
-	onWhite     = pushSGR $ SetColor Background Dull  White
-	onBlacker   = pushSGR $ SetColor Background Vivid Black
-	onRedder    = pushSGR $ SetColor Background Vivid Red
-	onGreener   = pushSGR $ SetColor Background Vivid Green
-	onYellower  = pushSGR $ SetColor Background Vivid Yellow
-	onBluer     = pushSGR $ SetColor Background Vivid Blue
-	onMagentaer = pushSGR $ SetColor Background Vivid Magenta
-	onCyaner    = pushSGR $ SetColor Background Vivid Cyan
-	onWhiter    = pushSGR $ SetColor Background Vivid White
-instance Doc_Decoration ANSI where
-	bold        = pushSGR $ SetConsoleIntensity BoldIntensity
-	underline   = pushSGR $ SetUnderlining SingleUnderline
-	italic      = pushSGR $ SetItalicized True
-
--- * Type 'ANSI_IO'
-newtype ANSI_IO = ANSI_IO { unANSI_IO :: [SGR] -> IO.Handle -> IO () }
-instance IsString ANSI_IO where
-	fromString s = ANSI_IO $ \_c h -> IO.hPutStr h t
-		where t = fromString s
-
-ansiIO :: ANSI_IO -> IO.Handle -> IO ()
-ansiIO (ANSI_IO d) = d []
-
-pushSGR_IO :: SGR -> ANSI_IO -> ANSI_IO
-pushSGR_IO c (ANSI_IO d) = ANSI_IO $ \cs h -> do
-	hSetSGR h [c]
-	d (c:cs) h
-	hSetSGR h $ Reset:L.reverse cs
-
-instance Semigroup ANSI_IO where
-	ANSI_IO x <> ANSI_IO y = ANSI_IO $ \c h -> do {x c h; y c h}
-instance Monoid ANSI_IO where
-	mempty  = empty
-	mappend = (<>)
-instance Doc_Text ANSI_IO where
-	empty         = ANSI_IO $ \_ _ -> return ()
-	replicate i d = ANSI_IO $ \c   -> replicateM_ i . unANSI_IO d c
-	int       i   = ANSI_IO $ \_ h -> IO.hPutStr  h (show i)
-	integer   i   = ANSI_IO $ \_ h -> IO.hPutStr  h (show i)
-	char      x   = ANSI_IO $ \_ h -> IO.hPutChar h x
-	string    x   = ANSI_IO $ \_ h -> IO.hPutStr  h x
-	text      x   = ANSI_IO $ \_ h -> T.hPutStr   h x
-	ltext     x   = ANSI_IO $ \_ h -> TL.hPutStr  h x
-	charH         = char
-	stringH       = string
-	textH         = text
-	ltextH        = ltext
-instance Doc_Color ANSI_IO where
-	reverse     = pushSGR_IO $ SetSwapForegroundBackground True
-	black       = pushSGR_IO $ SetColor Foreground Dull  Black
-	red         = pushSGR_IO $ SetColor Foreground Dull  Red
-	green       = pushSGR_IO $ SetColor Foreground Dull  Green
-	yellow      = pushSGR_IO $ SetColor Foreground Dull  Yellow
-	blue        = pushSGR_IO $ SetColor Foreground Dull  Blue
-	magenta     = pushSGR_IO $ SetColor Foreground Dull  Magenta
-	cyan        = pushSGR_IO $ SetColor Foreground Dull  Cyan
-	white       = pushSGR_IO $ SetColor Foreground Dull  White
-	blacker     = pushSGR_IO $ SetColor Foreground Vivid Black
-	redder      = pushSGR_IO $ SetColor Foreground Vivid Red
-	greener     = pushSGR_IO $ SetColor Foreground Vivid Green
-	yellower    = pushSGR_IO $ SetColor Foreground Vivid Yellow
-	bluer       = pushSGR_IO $ SetColor Foreground Vivid Blue
-	magentaer   = pushSGR_IO $ SetColor Foreground Vivid Magenta
-	cyaner      = pushSGR_IO $ SetColor Foreground Vivid Cyan
-	whiter      = pushSGR_IO $ SetColor Foreground Vivid White
-	onBlack     = pushSGR_IO $ SetColor Background Dull  Black
-	onRed       = pushSGR_IO $ SetColor Background Dull  Red
-	onGreen     = pushSGR_IO $ SetColor Background Dull  Green
-	onYellow    = pushSGR_IO $ SetColor Background Dull  Yellow
-	onBlue      = pushSGR_IO $ SetColor Background Dull  Blue
-	onMagenta   = pushSGR_IO $ SetColor Background Dull  Magenta
-	onCyan      = pushSGR_IO $ SetColor Background Dull  Cyan
-	onWhite     = pushSGR_IO $ SetColor Background Dull  White
-	onBlacker   = pushSGR_IO $ SetColor Background Vivid Black
-	onRedder    = pushSGR_IO $ SetColor Background Vivid Red
-	onGreener   = pushSGR_IO $ SetColor Background Vivid Green
-	onYellower  = pushSGR_IO $ SetColor Background Vivid Yellow
-	onBluer     = pushSGR_IO $ SetColor Background Vivid Blue
-	onMagentaer = pushSGR_IO $ SetColor Background Vivid Magenta
-	onCyaner    = pushSGR_IO $ SetColor Background Vivid Cyan
-	onWhiter    = pushSGR_IO $ SetColor Background Vivid White
-instance Doc_Decoration ANSI_IO where
-	bold        = pushSGR_IO $ SetConsoleIntensity BoldIntensity
-	underline   = pushSGR_IO $ SetUnderlining SingleUnderline
-	italic      = pushSGR_IO $ SetItalicized True
diff --git a/symantic-document/Language/Symantic/Document/Dim.hs b/symantic-document/Language/Symantic/Document/Dim.hs
index 21aa02a..bb6453f 100644
--- a/symantic-document/Language/Symantic/Document/Dim.hs
+++ b/symantic-document/Language/Symantic/Document/Dim.hs
@@ -1,9 +1,13 @@
 module Language.Symantic.Document.Dim where
 
-import Data.Eq (Eq)
+{-
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Eq (Eq(..))
 import Data.Foldable (Foldable(..))
 import Data.Function (($), id)
-import Data.Functor ((<$>))
+import Data.Functor ((<$>), ($>))
 import Data.Int (Int)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
@@ -14,35 +18,21 @@ import Text.Show (Show(..))
 import qualified Data.List as L
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
+import qualified Control.Monad.Trans.State as S
 
 import Language.Symantic.Document.Sym
 
 -- * Type 'Dim'
 data Dim
  =   Dim
- { width       :: Int -- ^ Maximun line length.
- , height      :: Int -- ^ Number of newlines.
- , width_first :: Int -- ^ Length of the first line.
- , width_last  :: Int -- ^ Length of the last line.
+ {   dim_width       :: Int -- ^ Maximun line length.
+ ,   dim_height      :: Int -- ^ Number of newlines.
+ ,   dim_width_first :: Int -- ^ Length of the first line.
+ ,   dim_width_last  :: Int -- ^ Length of the last line.
  } deriving (Eq, Show)
-instance IsString Dim where
-	fromString [] = Dim 0 0 0 0
-	fromString s =
-		Dim
-		 { width       = maximum ws
-		 , height      = length ls
-		 , width_first = if null ws then 0 else L.head ws
-		 , width_last  = if null ws then 0 else L.last ws
-		 }
-		where
-		ls = L.lines s
-		ws = length <$> ls
-
-dim :: Dim -> Dim
-dim = id
-
 instance Semigroup Dim where
-	Dim wx hx wfx wlx <> Dim wy hy wfy wly =
+	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
+	 Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
 		let h = hx + hy in
 		case (hx, hy) of
 		 (0, 0) -> let w = wx  + wy  in Dim w h w w
@@ -50,19 +40,67 @@ instance Semigroup Dim where
 		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
 		 _      -> Dim (max wx wy) h wfx wly
 instance Monoid Dim where
+	mempty  = Dim 0 0 0 0
+	mappend = (<>)
+
+-- * Type 'Dimension'
+newtype Dimension = Dimension { unDimension :: Inh -> S.State Column Dim }
+
+instance IsString Dimension where
+	fromString [] = mempty
+	fromString s =
+		Dimension $ \inh ->
+			let ls = L.lines s in
+			return $
+			case inh_newline inh of
+			 NewlineEmpty ->
+				let w = sum $ length <$> ls in
+				Dim
+				 { dim_width       = w
+				 , dim_height      = 0
+				 , dim_width_first = w
+				 , dim_width_last  = w
+				 }
+			 NewlineWithIndent ->
+				let ws = case length <$> ls of [] -> []; c:cs -> c : ((inh_indent inh +)<$>cs) in
+				Dim
+				 { dim_width       = maximum ws
+				 , dim_height      = length ls
+				 , dim_width_first = if null ws then 0 else L.head ws
+				 , dim_width_last  = if null ws then 0 else L.last ws
+				 }
+			 NewlineWithoutIndent ->
+				let ws = length <$> ls in
+				Dim
+				 { dim_width       = maximum ws
+				 , dim_height      = length ls
+				 , dim_width_first = if null ws then 0 else L.head ws
+				 , dim_width_last  = if null ws then 0 else L.last ws
+				 }
+
+dimension :: Dimension -> Dimension
+dimension = id
+
+
+instance Semigroup Dimension where
+	-- Dimension x <> Dimension y = Dimension (x <> y)
+	Dimension x <> Dimension y = Dimension (\inh -> (<>) <$> x inh <*> y inh)
+instance Monoid Dimension where
 	mempty  = empty
 	mappend = (<>)
-instance Doc_Text Dim where
-	spaces    i   = Dim i 0 i i
+instance Doc_Text Dimension where
+	spaces    i   = Dimension $ \_inh -> return $ Dim i 0 i i
 	replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
-	int       i   = fromString $ show i
-	integer   i   = fromString $ show i
-	charH     _c  = Dim 1 0 1 1
-	stringH   t   = Dim l 0 l l where l = length t
-	textH     t   = Dim l 0 l l where l = T.length t
-	ltextH    t   = Dim l 0 l l where l = fromInteger $ toInteger $ TL.length t
+	int       i   = stringH $ show i
+	integer   i   = stringH $ show i
+	empty         = Dimension $ \_inh -> return mempty
+	newline       = Dimension $ \_inh -> return $ Dim 0 1 0 0
+	charH     _c  = incrColumn $ 1
+	stringH   t   = incrColumn $ length t
+	textH     t   = incrColumn $ T.length t
+	ltextH    t   = incrColumn $ fromInteger $ toInteger $ TL.length t
 	                                    -- XXX: conversion may overflow
-instance Doc_Color Dim where
+instance Doc_Color Dimension where
 	reverse     = id
 	black       = id
 	red         = id
@@ -96,7 +134,10 @@ instance Doc_Color Dim where
 	onMagentaer = id
 	onCyaner    = id
 	onWhiter    = id
-instance Doc_Decoration Dim where
+instance Doc_Decoration Dimension where
 	bold        = id
 	underline   = id
 	italic      = id
+instance Doc_Align Dimension where
+instance Doc_Wrap Dimension where
+-}
diff --git a/symantic-document/Language/Symantic/Document/Plain.hs b/symantic-document/Language/Symantic/Document/Plain.hs
index 95ba70c..7624904 100644
--- a/symantic-document/Language/Symantic/Document/Plain.hs
+++ b/symantic-document/Language/Symantic/Document/Plain.hs
@@ -1,92 +1,195 @@
 module Language.Symantic.Document.Plain where
 
-import Control.Monad (Monad(..), replicateM_)
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Int (Int)
 import Data.Function (($), (.), id)
 import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
-import System.IO (IO)
+import Prelude ((+), pred)
+import GHC.Exts (IsList(..))
+import System.Console.ANSI
 import Text.Show (Show(..))
-import qualified Data.Text.IO as T
+import qualified Data.List as List
+import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.IO as TL
 import qualified Data.Text.Lazy.Builder as TLB
-import qualified System.IO as IO
+-- import qualified Data.Text.Lazy.IO as TL
+-- import qualified System.IO as IO
 
 import Language.Symantic.Document.Sym
 
+-- * Type 'Inh'
+data Inh
+ =   Inh
+ {   inh_indent      :: !(Indent Plain) -- ^ Current indentation level, used by 'newline'.
+ ,   inh_newline     :: Plain           -- ^ How to display 'newline'.
+ ,   inh_wrap_column :: !(Column Plain) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   inh_sgr         :: ![SGR]          -- ^ Active ANSI codes.
+ }
+
+defInh :: Inh
+defInh = Inh
+ { inh_indent      = 0
+ , inh_newline     = newlineWithIndent
+ , inh_wrap_column = 80
+ , inh_sgr         = []
+ }
+
+-- * Type 'State'
+data State
+ =   State
+ {   state_column     :: !(Column Plain)
+ ,   state_column_max :: !(Column Plain)
+ }
+
+defState :: State
+defState = State
+ { state_column     = 0
+ , state_column_max = 0
+ }
+
 -- * Type 'Plain'
 newtype Plain
- =      Plain TLB.Builder
- deriving (Show)
-instance IsString Plain where
-	fromString = Plain . fromString
+ =      Plain
+ {    unPlain :: Inh -> State
+              -> (State -> TLB.Builder -> TLB.Builder) -- normal   continuation
+              -> (State -> TLB.Builder -> TLB.Builder) -- wrapping continuation
+              -> TLB.Builder }
 
-plain :: Plain -> TLB.Builder
-plain (Plain d) = d
+buildPlain :: Plain -> TLB.Builder
+buildPlain (Plain p) = p defInh defState oko oko
+	where oko _st = id
 
+textPlain :: Plain -> TL.Text
+textPlain = TLB.toLazyText . buildPlain
+
+instance IsList Plain where
+	type Item Plain = Plain
+	fromList = mconcat
+	toList   = pure
 instance Semigroup Plain where
-	Plain x <> Plain y = Plain (x <> y)
+	x <> y = Plain $ \inh st ok ko ->
+		unPlain x inh st
+		 (\sx tx -> unPlain y inh sx
+			 (\sy ty -> ok sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+		 (\sx tx -> unPlain y inh sx
+			 (\sy ty -> ko sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
 instance Monoid Plain where
 	mempty  = empty
 	mappend = (<>)
+instance IsString Plain where
+	fromString = string
+
+plainWrite :: Column Plain -> TLB.Builder -> Plain
+plainWrite len t =
+	Plain $ \inh st ok ko ->
+		let newCol = state_column st + len in
+		(if newCol <= inh_wrap_column inh then ok else ko)
+		st{ state_column     = newCol
+		  , state_column_max = max (state_column_max st) newCol
+		  } t
+
 instance Doc_Text Plain where
-	int         = Plain . fromString . show
-	integer     = Plain . fromString . show
-	replicate i = Plain . TLB.fromLazyText . TL.replicate (int64OfInt i) . TLB.toLazyText . plain
-	char        = Plain . TLB.singleton
-	string      = Plain . fromString
-	text        = Plain . TLB.fromText
-	ltext       = Plain . TLB.fromLazyText
-	charH       = char
-	stringH     = string
-	textH       = text
-	ltextH      = ltext
+	empty     = Plain $ \_inh st ok _ko -> ok st ""
+	charH   t = plainWrite 1 $ TLB.singleton t
+	stringH t = plainWrite (List.length t) (fromString t)
+	textH   t = plainWrite (Text.length t) (TLB.fromText t)
+	ltextH  t = plainWrite (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
+	int       = stringH . show
+	integer   = stringH . show
+	replicate cnt p | cnt <= 0  = empty
+	                | otherwise = p <> replicate (pred cnt) p
+	newline = Plain $ \inh -> unPlain (inh_newline inh) inh
+
+newlineWithoutIndent :: Plain
+newlineWithoutIndent = Plain $ \_inh st ok _ko ->
+	ok st{state_column=0} $ TLB.singleton '\n'
+
+newlineWithIndent :: Plain
+newlineWithIndent = Plain $ \inh st ok _ko ->
+	ok st
+	 { state_column     = inh_indent inh
+	 , state_column_max = max (state_column_max st) (inh_indent inh)
+	 } $
+		TLB.singleton '\n' <>
+		fromString (List.replicate (inh_indent inh) ' ')
+
+instance Doc_Align Plain where
+	type Column Plain = Int
+	type Indent Plain = Int
+	align p = Plain $ \inh st -> unPlain p inh{inh_indent=state_column st} st
+	withNewline nl  p = Plain $ \inh -> unPlain p inh{inh_newline=nl}
+	withIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=ind}
+	incrIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=inh_indent inh + ind}
+instance Doc_Wrap Plain where
+	ifFit x y = Plain $ \inh st ok ko ->
+		unPlain x inh st ok (\_sx _tx -> unPlain y inh st ok ko)
+	breakpoint onNoBreak onBreak p = Plain $ \inh st ok ko ->
+		unPlain (onNoBreak <> p) inh st ok
+		 (\_sp _tp -> unPlain (onBreak <> p) inh st ok ko)
+	withWrapColumn col p = Plain $ \inh -> unPlain p inh{inh_wrap_column=col}
+
+writeSGR :: SGR -> Plain -> Plain
+writeSGR s p = Plain $ \inh@Inh{inh_sgr=ss} st ok ko ->
+	let o = Plain $ \_inh st' ok' _ko -> ok' st' $ fromString $ setSGRCode [s] in
+	let c :: TLB.Builder = fromString $ setSGRCode $ Reset:List.reverse ss in
+	unPlain (o<>p) inh{inh_sgr=s:ss} st
+	 (\_st t -> ok st $ t<>c)
+	 (\_st t -> ko st $ t<>c)
+
 instance Doc_Color Plain where
-	reverse     = id
-	black       = id
-	red         = id
-	green       = id
-	yellow      = id
-	blue        = id
-	magenta     = id
-	cyan        = id
-	white       = id
-	blacker     = id
-	redder      = id
-	greener     = id
-	yellower    = id
-	bluer       = id
-	magentaer   = id
-	cyaner      = id
-	whiter      = id
-	onBlack     = id
-	onRed       = id
-	onGreen     = id
-	onYellow    = id
-	onBlue      = id
-	onMagenta   = id
-	onCyan      = id
-	onWhite     = id
-	onBlacker   = id
-	onRedder    = id
-	onGreener   = id
-	onYellower  = id
-	onBluer     = id
-	onMagentaer = id
-	onCyaner    = id
-	onWhiter    = id
+	reverse     = writeSGR $ SetSwapForegroundBackground True
+	black       = writeSGR $ SetColor Foreground Dull  Black
+	red         = writeSGR $ SetColor Foreground Dull  Red
+	green       = writeSGR $ SetColor Foreground Dull  Green
+	yellow      = writeSGR $ SetColor Foreground Dull  Yellow
+	blue        = writeSGR $ SetColor Foreground Dull  Blue
+	magenta     = writeSGR $ SetColor Foreground Dull  Magenta
+	cyan        = writeSGR $ SetColor Foreground Dull  Cyan
+	white       = writeSGR $ SetColor Foreground Dull  White
+	blacker     = writeSGR $ SetColor Foreground Vivid Black
+	redder      = writeSGR $ SetColor Foreground Vivid Red
+	greener     = writeSGR $ SetColor Foreground Vivid Green
+	yellower    = writeSGR $ SetColor Foreground Vivid Yellow
+	bluer       = writeSGR $ SetColor Foreground Vivid Blue
+	magentaer   = writeSGR $ SetColor Foreground Vivid Magenta
+	cyaner      = writeSGR $ SetColor Foreground Vivid Cyan
+	whiter      = writeSGR $ SetColor Foreground Vivid White
+	onBlack     = writeSGR $ SetColor Background Dull  Black
+	onRed       = writeSGR $ SetColor Background Dull  Red
+	onGreen     = writeSGR $ SetColor Background Dull  Green
+	onYellow    = writeSGR $ SetColor Background Dull  Yellow
+	onBlue      = writeSGR $ SetColor Background Dull  Blue
+	onMagenta   = writeSGR $ SetColor Background Dull  Magenta
+	onCyan      = writeSGR $ SetColor Background Dull  Cyan
+	onWhite     = writeSGR $ SetColor Background Dull  White
+	onBlacker   = writeSGR $ SetColor Background Vivid Black
+	onRedder    = writeSGR $ SetColor Background Vivid Red
+	onGreener   = writeSGR $ SetColor Background Vivid Green
+	onYellower  = writeSGR $ SetColor Background Vivid Yellow
+	onBluer     = writeSGR $ SetColor Background Vivid Blue
+	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
+	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
+	onWhiter    = writeSGR $ SetColor Background Vivid White
 instance Doc_Decoration Plain where
-	bold        = id
-	underline   = id
-	italic      = id
+	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
+	underline   = writeSGR $ SetUnderlining SingleUnderline
+	italic      = writeSGR $ SetItalicized True
+
+
+
 
+{-
 -- * Type 'PlainIO'
 newtype PlainIO
- =      PlainIO { unPlainH :: IO.Handle -> IO () }
+ =      PlainIO { unPlainIO :: IO.Handle -> IO () }
 instance IsString PlainIO where
-	fromString s = PlainIO $ \h -> IO.hPutStr h t
-		where t = fromString s
+	fromString s = PlainIO $ \h -> IO.hPutStr h s
 
 plainIO :: PlainIO -> IO.Handle -> IO ()
 plainIO (PlainIO d) = d
@@ -101,14 +204,15 @@ instance Doc_Text PlainIO where
 	int     i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 	integer i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 	replicate i d = PlainIO $ replicateM_ i . plainIO d
-	char    x     = PlainIO $ \h -> IO.hPutChar h x
-	string  x     = PlainIO $ \h -> IO.hPutStr  h x
-	text    x     = PlainIO $ \h -> T.hPutStr   h x
-	ltext   x     = PlainIO $ \h -> TL.hPutStr  h x
-	charH         = char
-	stringH       = string
-	textH         = text
-	ltextH        = ltext
+	charH   x     = PlainIO $ \h -> IO.hPutChar h x
+	stringH x     = PlainIO $ \h -> IO.hPutStr  h x
+	textH   x     = PlainIO $ \h -> Text.hPutStr h x
+	ltextH  x     = PlainIO $ \h -> TL.hPutStr  h x
+	-- NOTE: PlainIO has no support for indentation, hence char = charH, etc.
+	char          = charH
+	string        = stringH
+	text          = textH
+	ltext         = ltextH
 instance Doc_Color PlainIO where
 	reverse       = id
 	black         = id
@@ -147,3 +251,4 @@ instance Doc_Decoration PlainIO where
 	bold          = id
 	underline     = id
 	italic        = id
+-}
diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 2fe2863..2d181d0 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -1,15 +1,14 @@
-{-# LANGUAGE PolyKinds #-}
 module Language.Symantic.Document.Sym where
 
 import Data.Char (Char)
 import Data.Foldable (Foldable(..))
-import Data.Function ((.))
+import Data.Function ((.), ($))
 import Data.Functor (Functor(..))
 import Data.Int (Int, Int64)
 import Data.Semigroup (Semigroup(..))
 import Data.String (String, IsString)
 import Data.Text (Text)
-import Prelude (Integer, fromInteger, toInteger)
+import Prelude (Integer, toInteger, fromIntegral)
 import qualified Data.List as L
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -22,12 +21,12 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	ltextH    :: TL.Text -> d -- ^ XXX: MUST NOT contain '\n'
 	replicate :: Int -> d -> d
 	integer   :: Integer -> d
+	default replicate :: Doc_Text (ReprOf d) => Trans d => Int -> d -> d
+	default integer   :: Doc_Text (ReprOf d) => Trans d => Integer -> d
 	default charH     :: Doc_Text (ReprOf d) => Trans d => Char -> d
 	default stringH   :: Doc_Text (ReprOf d) => Trans d => String -> d
 	default textH     :: Doc_Text (ReprOf d) => Trans d => Text -> d
 	default ltextH    :: Doc_Text (ReprOf d) => Trans d => TL.Text -> d
-	default replicate :: Doc_Text (ReprOf d) => Trans d => Int -> d -> d
-	default integer   :: Doc_Text (ReprOf d) => Trans d => Integer -> d
 	charH     = trans . charH
 	stringH   = trans . stringH
 	textH     = trans . textH
@@ -35,48 +34,91 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	replicate = trans1 . replicate
 	integer   = trans . integer
 	
-	empty     :: d
-	eol       :: d
-	space     :: d
-	spaces    :: Int -> d
-	int       :: Int -> d
-	char      :: Char    -> d
-	string    :: String  -> d
-	text      :: Text    -> d
-	ltext     :: TL.Text -> d
-	catH      :: Foldable f => f d -> d
-	catV      :: Foldable f => f d -> d
-	paren     :: d -> d
-	brace     :: d -> d
-	bracket   :: d -> d
-	bquote    :: d -> d
-	dquote    :: d -> d
-	fquote    :: d -> d
-	squote    :: d -> d
+	empty       :: d
+	newline     :: d
+	space       :: d
+	spaces      :: Int -> d
+	int         :: Int -> d
+	char        :: Char    -> d
+	string      :: String  -> d
+	text        :: Text    -> d
+	ltext       :: TL.Text -> d
+	catH        :: Foldable f => f d -> d
+	catV        :: Foldable f => f d -> d
+	foldrWith   :: Foldable f => (d -> d -> d) -> f d -> d
+	foldWith    :: Foldable f => (d -> d) -> f d -> d
+	intercalate :: Foldable f => d -> f d -> d
+	between     :: d -> d -> d -> d
 	
-	empty     = ""
-	eol       = "\n"
-	space     = char ' '
-	spaces i  = replicate i space
-	int       = integer . toInteger
-	char      = \case '\n' -> eol; c -> charH c
-	string    = catV . fmap stringH . L.lines
-	text      = catV . fmap textH   . T.lines
-	ltext     = catV . fmap ltextH  . TL.lines
-	catH      = foldr (<>) empty
-	catV l    = if null l then empty else foldr1 (\a acc -> a <> eol <> acc) l
-	paren   d = charH '('   <> d <> charH ')'
-	brace   d = charH '{'   <> d <> charH '}'
-	bracket d = charH '['   <> d <> charH ']'
-	bquote  d = charH '`'   <> d <> charH '`'
-	dquote  d = charH '\"'  <> d <> charH '\"'
-	fquote  d =       "« "  <> d <>       " »"
-	squote  d = charH '\''  <> d <> charH '\''
+	newline  = "\n"
+	space    = char ' '
+	spaces i = replicate i space
+	int      = integer . toInteger
+	char     = \case '\n' -> newline; c -> charH c
+	string   = catV . fmap stringH . L.lines
+	text     = catV . fmap textH   . T.lines
+	ltext    = catV . fmap ltextH  . TL.lines
+	catH     = foldr (<>) empty
+	catV     = foldrWith (\x y -> x<>newline<>y)
+	foldrWith f ds  = if null ds then empty else foldr1 f ds
+	foldWith  f = foldrWith (\a acc -> a <> f acc)
+	intercalate sep = foldrWith (\x y -> x<>sep<>y)
+	between o c d = o<>d<>c
 	-- default catH :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
 	-- default catV :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
 	-- catH  l = trans (catH (fmap unTrans l))
 	-- catV  l = trans (catV (fmap unTrans l))
 
+-- * Class 'Doc_Align'
+class Doc_Align d where
+	type Newline d
+	type Newline d = d
+	type Column d
+	type Column d = Int
+	type Indent d
+	type Indent d = Int
+	-- | @align d@, make @d@ uses current 'Column' as 'Indent' level.
+	align :: d -> d
+	-- | @hang ind d@, make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
+	hang :: Indent d -> d -> d
+	hang ind = align . incrIndent ind
+	-- | @incrIndent ind d@, make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
+	incrIndent  :: Indent d -> d -> d
+	-- | @withIndent ind d@, make @d@ uses @ind@ as 'Indent' level.
+	withIndent  :: Indent d -> d -> d
+	-- | @withNewline nl d@, make @d@ uses @nl@ as 'newline'.
+	withNewline :: d -> Newline d -> d
+
+-- * Class 'Doc_Wrap'
+class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
+	-- | @ifFit onFit onNoFit@,
+	-- return @onFit@ if @onFit@ leads to a 'Column'
+	-- lower or equal to the one sets with 'withWrapColumn',
+	-- otherwise return @onNoFit@.
+	ifFit :: d -> d -> d
+	-- | @breakpoint onNoBreak onBreak d@,
+	-- return @onNoBreak@ then @d@ if they fit,
+	-- @onBreak@ otherwise.
+	breakpoint :: d -> d -> d -> d
+	-- | @breakableEmpty d@, return @d@ if it fits, 'newline' then @d@ otherwise.
+	breakableEmpty :: d -> d
+	breakableEmpty = breakpoint empty newline
+	-- | @breakableSpace d@, return 'space' then @d@ it they fit, 'newline' then @d@ otherwise.
+	breakableSpace :: d -> d
+	breakableSpace = breakpoint space newline
+	-- | @breakableSpaces ds@ intercalate a 'breakableSpace' between items of @ds@.
+	breakableSpaces :: Foldable f => f d -> d
+	breakableSpaces = foldWith breakableSpace
+	-- | @withWrapColumn col d@ set the 'Column' triggering wrapping to @col@ within @d@.
+	withWrapColumn :: Column d -> d -> d
+	-- | @intercalateHorV sep ds@,
+	-- return @ds@ with @sep@ intercalated if the whole fits,
+	-- otherwise return 'align' of @ds@ with 'newline' and @sep@ intercalated.
+	intercalateHorV :: Foldable f => d -> f d -> d
+	intercalateHorV sep xs =
+		ifFit    (foldr1 (\a acc -> a <> sep            <> acc) xs)
+		 (align $ foldr1 (\a acc -> a <> newline <> sep <> acc) xs)
+
 -- * Class 'Doc_Color'
 class Doc_Color d where
 	reverse :: d -> d
@@ -230,4 +272,7 @@ class Trans tr where
 	trans3 f t1 t2 t3 = trans (f (unTrans t1) (unTrans t2) (unTrans t3))
 
 int64OfInt :: Int -> Int64
-int64OfInt = fromInteger . toInteger
+int64OfInt = fromIntegral
+
+intOfInt64 :: Int64 -> Int
+intOfInt64 = fromIntegral
diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index 36ee488..8c8f15d 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -29,14 +29,12 @@ source-repository head
 Library
   exposed-modules:
     Language.Symantic.Document
-    Language.Symantic.Document.ANSI
     Language.Symantic.Document.Dim
     Language.Symantic.Document.Plain
     Language.Symantic.Document.Sym
     Language.Symantic.Document.Valid
   default-language: Haskell2010
   default-extensions:
-    NoImplicitPrelude
     DataKinds
     DefaultSignatures
     FlexibleContexts
@@ -44,6 +42,7 @@ Library
     LambdaCase
     MultiParamTypeClasses
     NamedFieldPuns
+    NoImplicitPrelude
     OverloadedStrings
     ScopedTypeVariables
     StandaloneDeriving
@@ -60,3 +59,44 @@ Library
       ansi-terminal >= 0.7
     , base          >= 4.6 && < 5
     , text          >= 1.2
+    , transformers  >= 0.5
+
+Test-Suite symantic-document-test
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  other-modules:
+    HUnit
+  default-language: Haskell2010
+  default-extensions:
+    DataKinds
+    FlexibleContexts
+    FlexibleInstances
+    LambdaCase
+    MultiParamTypeClasses
+    NoImplicitPrelude
+    NoMonomorphismRestriction
+    OverloadedStrings
+    ScopedTypeVariables
+    TupleSections
+    TypeApplications
+    TypeFamilies
+    TypeOperators
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-tabs
+    -fhide-source-paths
+    -fprint-explicit-kinds
+    -- -O0
+    -- -fmax-simplifier-iterations=0
+    -- -dshow-passes
+  build-depends:
+      symantic-document
+    , base             >= 4.6 && < 5
+    , containers       >= 0.5
+    , tasty            >= 0.11
+    , tasty-hunit      >= 0.9
+    , text             >= 1.2
+    , transformers     >= 0.5
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
new file mode 100644
index 0000000..0a2a4ee
--- /dev/null
+++ b/symantic-document/test/HUnit.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TypeApplications #-}
+module HUnit where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+-- import Data.Monoid (Monoid(..))
+-- import qualified Control.Monad.Trans.State as S
+import qualified Data.List as List
+import Text.Show (Show(..))
+import Data.Functor ((<$>))
+-- import qualified Data.Text.Lazy.Builder as TLB
+import Prelude (Num)
+import Data.Foldable (Foldable(..))
+import Data.Function (($))
+import Data.Int (Int)
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String)
+import qualified Data.Text.Lazy as TL
+
+import qualified Language.Symantic.Document as Doc
+
+-- * Tests
+hunits :: TestTree
+hunits = testGroup "HUnit" $
+ [ hunitsPlain
+ ]
+
+infix 0 ==>
+(==>) :: Doc.Plain -> TL.Text -> Assertion
+p ==> expected = got @?= expected
+	where got = Doc.textPlain p
+
+testList :: String -> [Assertion] -> TestTree
+testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
+
+testMessage :: TL.Text -> String
+testMessage msg =
+	foldMap esc $ TL.unpack $
+	if 42 < TL.length msg then excerpt else msg
+	where
+	excerpt = TL.take 42 msg <> "…"
+	esc = \case
+	 '\n' -> "\\n"
+	 c -> [c]
+
+hunitsPlain :: TestTree
+hunitsPlain = testGroup "Plain"
+ [ testList "Doc_Text"
+   [ Doc.newline ==> "\n"
+   , Doc.stringH "hello" ==> "hello"
+   , "hello" ==> "hello"
+   , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
+   ]
+ , testList "Doc_Align"
+   [ "hello\nworld" ==> "hello\nworld"
+   , "  "<> "hello\nworld\n!" ==> "  hello\nworld\n!"
+   , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n  world\n  !"
+   , Doc.hang 2 "hello\nworld\n!" ==> "hello\n  world\n  !"
+   , Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n  world\n  !\nhello\n!"
+   ]
+ , testList "Doc_Wrap"
+   [ 10`wc` be ["hello", "world"] ==> "helloworld"
+   ,  9`wc` be ["hello", "world"] ==> "hello\nworld"
+   ,  6`wc` be ["he", "ll", "o!"] ==> "hello!"
+   ,  6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
+   ,  5`wc` be ["hello", "world"] ==> "hello\nworld"
+   ,  5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
+   ,  5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
+   ,  4`wc` be ["hello", "world"] ==> "hello\nworld"
+   ,  4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
+   ,  4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
+   ,  4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
+   ,  4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
+   ,  3`wc` be ["hello", "world"] ==> "hello\nworld"
+   ,  3`wc` be ["he", "ll"] ==> "he\nll"
+   ,  3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
+   ,  1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
+   ,  4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n  ll\n  o!\n  wo\n  rl\n  d!"
+   ,  6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n  o!wo\n  rld!"
+   , 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
+   ,  4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n  , world\n  ]"
+   , 11`wc` bs ["hello", "world"] ==> "hello world"
+   , 10`wc` bs ["hello", "world"] ==> "hello\nworld"
+   ,  5`wc` bs ["hello", "world"] ==> "hello\nworld"
+   , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
+     ==> "function(function(\n    function(\n      function(\n        function(\n          [ abcdefg\n          , abcdefg\n          ]\n          )\n        )\n      )\n    ))"
+   , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
+     ==> "function(\n  function(\n    function(\n      function(\n        function(\n          [ abcdefgh\n          , abcdefgh\n          ]\n          )\n        )\n      )\n    )\n  )"
+   ]
+ ]
+
+be :: Doc.Doc_Wrap d => [d] -> d
+be = Doc.foldWith Doc.breakableEmpty
+bs :: Doc.Doc_Wrap d => [d] -> d
+bs = Doc.foldWith Doc.breakableSpace
+wc :: Doc.Doc_Wrap d => Doc.Column d -> d -> d
+wc = Doc.withWrapColumn
+
+fun :: (Doc.Doc_Align d, Doc.Doc_Wrap d, Num (Doc.Indent d)) => d -> d
+fun x = "function(" <> Doc.incrIndent 2 (Doc.ifFit (x) (Doc.newline<>x<>Doc.newline)) <> ")"
+
+listHorV :: (Doc.Doc_Align d, Doc.Doc_Wrap d) => [d] -> d
+listHorV [] = "[]"
+listHorV [x] = "["<>x<>"]"
+listHorV xs =
+	Doc.ifFit
+	 ("[" <> Doc.intercalate ", " xs <> "]")
+	 (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
diff --git a/symantic-document/test/Main.hs b/symantic-document/test/Main.hs
new file mode 100644
index 0000000..ee82889
--- /dev/null
+++ b/symantic-document/test/Main.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import Data.Function (($))
+import System.IO (IO)
+import Test.Tasty
+
+import HUnit
+
+main :: IO ()
+main = do
+	defaultMain $
+		testGroup "Document"
+		 [ hunits
+		 ]
-- 
2.44.1


From 474ab9b063f49a371b830b6d981493d92308af0c Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 6 Mar 2018 02:02:10 +0100
Subject: [PATCH 09/16] Improve Doc_Align and Doc_Wrap.

---
 .../Language/Symantic/Document/Plain.hs       | 31 ++++-------
 .../Language/Symantic/Document/Sym.hs         | 54 ++++++++++++++++---
 symantic-document/test/HUnit.hs               | 13 +++++
 3 files changed, 70 insertions(+), 28 deletions(-)

diff --git a/symantic-document/Language/Symantic/Document/Plain.hs b/symantic-document/Language/Symantic/Document/Plain.hs
index 7624904..92766dd 100644
--- a/symantic-document/Language/Symantic/Document/Plain.hs
+++ b/symantic-document/Language/Symantic/Document/Plain.hs
@@ -39,17 +39,10 @@ defInh = Inh
  }
 
 -- * Type 'State'
-data State
- =   State
- {   state_column     :: !(Column Plain)
- ,   state_column_max :: !(Column Plain)
- }
+type State = Column Plain
 
 defState :: State
-defState = State
- { state_column     = 0
- , state_column_max = 0
- }
+defState = 0
 
 -- * Type 'Plain'
 newtype Plain
@@ -88,11 +81,9 @@ instance IsString Plain where
 plainWrite :: Column Plain -> TLB.Builder -> Plain
 plainWrite len t =
 	Plain $ \inh st ok ko ->
-		let newCol = state_column st + len in
+		let newCol = st + len in
 		(if newCol <= inh_wrap_column inh then ok else ko)
-		st{ state_column     = newCol
-		  , state_column_max = max (state_column_max st) newCol
-		  } t
+		newCol t
 
 instance Doc_Text Plain where
 	empty     = Plain $ \_inh st ok _ko -> ok st ""
@@ -107,25 +98,23 @@ instance Doc_Text Plain where
 	newline = Plain $ \inh -> unPlain (inh_newline inh) inh
 
 newlineWithoutIndent :: Plain
-newlineWithoutIndent = Plain $ \_inh st ok _ko ->
-	ok st{state_column=0} $ TLB.singleton '\n'
+newlineWithoutIndent = Plain $ \_inh _st ok _ko ->
+	ok 0 $ TLB.singleton '\n'
 
 newlineWithIndent :: Plain
-newlineWithIndent = Plain $ \inh st ok _ko ->
-	ok st
-	 { state_column     = inh_indent inh
-	 , state_column_max = max (state_column_max st) (inh_indent inh)
-	 } $
+newlineWithIndent = Plain $ \inh _st ok _ko ->
+	ok (inh_indent inh) $
 		TLB.singleton '\n' <>
 		fromString (List.replicate (inh_indent inh) ' ')
 
 instance Doc_Align Plain where
 	type Column Plain = Int
 	type Indent Plain = Int
-	align p = Plain $ \inh st -> unPlain p inh{inh_indent=state_column st} st
+	align p = Plain $ \inh st -> unPlain p inh{inh_indent=st} st
 	withNewline nl  p = Plain $ \inh -> unPlain p inh{inh_newline=nl}
 	withIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=ind}
 	incrIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=inh_indent inh + ind}
+	column f = Plain $ \inh st -> unPlain (f st) inh st
 instance Doc_Wrap Plain where
 	ifFit x y = Plain $ \inh st ok ko ->
 		unPlain x inh st ok (\_sx _tx -> unPlain y inh st ok ko)
diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 2d181d0..d1726e6 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -5,10 +5,11 @@ import Data.Foldable (Foldable(..))
 import Data.Function ((.), ($))
 import Data.Functor (Functor(..))
 import Data.Int (Int, Int64)
+import Data.Ord (Ord(..), Ordering(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String, IsString)
 import Data.Text (Text)
-import Prelude (Integer, toInteger, fromIntegral)
+import Prelude (Integer, toInteger, fromIntegral, Num(..))
 import qualified Data.List as L
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -37,7 +38,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	empty       :: d
 	newline     :: d
 	space       :: d
-	spaces      :: Int -> d
+	(<+>)       :: d -> d -> d
 	int         :: Int -> d
 	char        :: Char    -> d
 	string      :: String  -> d
@@ -52,7 +53,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	
 	newline  = "\n"
 	space    = char ' '
-	spaces i = replicate i space
+	x <+> y  = x <> space <> y
 	int      = integer . toInteger
 	char     = \case '\n' -> newline; c -> charH c
 	string   = catV . fmap stringH . L.lines
@@ -70,9 +71,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	-- catV  l = trans (catV (fmap unTrans l))
 
 -- * Class 'Doc_Align'
-class Doc_Align d where
-	type Newline d
-	type Newline d = d
+class Doc_Text d => Doc_Align d where
 	type Column d
 	type Column d = Int
 	type Indent d
@@ -87,7 +86,48 @@ class Doc_Align d where
 	-- | @withIndent ind d@, make @d@ uses @ind@ as 'Indent' level.
 	withIndent  :: Indent d -> d -> d
 	-- | @withNewline nl d@, make @d@ uses @nl@ as 'newline'.
-	withNewline :: d -> Newline d -> d
+	withNewline :: d -> d -> d
+	-- | @column f@, return @f@ applied to the current 'Column'.
+	column :: (Column d -> d) -> d
+	-- | @endToEndWidth d f@, return @d@ concatenated to
+	-- @f@ applied to the difference between the end 'Column' and start 'Column' of @d@.
+	--
+	-- Note that @f@ is given the end-to-end width,
+	-- which is not necessarily the maximal width.
+	default endToEndWidth ::
+	 Semigroup d =>
+	 Num (Column d) =>
+	 d -> (Column d -> d) -> d
+	endToEndWidth :: d -> (Column d -> d) -> d
+	endToEndWidth d f = column $ \c1 -> (d <>) $ column $ \c2 -> f $ c2 - c1
+	
+	-- | @spaces ind@, replicates 'space' @ind@ times.
+	default spaces :: Indent d ~ Int => Indent d -> d
+	spaces :: Indent d -> d
+	spaces i = replicate i space
+	
+	default fill ::
+	 Indent d ~ Int =>
+	 Column d ~ Int =>
+	 Indent d -> d -> d
+	fill :: Indent d -> d -> d
+	fill m d =
+		endToEndWidth d $ \w ->
+			case w`compare`m of
+			 LT -> spaces $ m - w
+			 _  -> empty
+	
+	default breakableFill ::
+	 Indent d ~ Int =>
+	 Column d ~ Int =>
+	 Indent d -> d -> d
+	breakableFill :: Indent d -> d -> d
+	breakableFill m d =
+		endToEndWidth d $ \w ->
+			case w`compare`m of
+			 LT -> spaces $ m - w
+			 EQ -> empty
+			 GT -> incrIndent m newline
 
 -- * Class 'Doc_Wrap'
 class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 0a2a4ee..5aad25e 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -21,6 +21,7 @@ import Data.String (String)
 import qualified Data.Text.Lazy as TL
 
 import qualified Language.Symantic.Document as Doc
+import Language.Symantic.Document ((<+>))
 
 -- * Tests
 hunits :: TestTree
@@ -60,6 +61,18 @@ hunitsPlain = testGroup "Plain"
    , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n  world\n  !"
    , Doc.hang 2 "hello\nworld\n!" ==> "hello\n  world\n  !"
    , Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n  world\n  !\nhello\n!"
+   , "let " <> Doc.align (Doc.catV $
+               (\(name, typ) -> Doc.fill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
+               `List.map` [ ("abcdef","Doc")
+                          , ("abcde","Int -> Doc -> Doc")
+                          , ("abcdefghi","Doc") ])
+     ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi :: Doc"
+   , "let " <> Doc.align (Doc.catV $
+               (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
+               `List.map` [ ("abcdef","Doc")
+                          , ("abcde","Int -> Doc -> Doc")
+                          , ("abcdefghi","Doc") ])
+     ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi\n           :: Doc"
    ]
  , testList "Doc_Wrap"
    [ 10`wc` be ["hello", "world"] ==> "helloworld"
-- 
2.44.1


From 9481173b86e768147feb6f9515d212e098635449 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Tue, 6 Mar 2018 04:32:26 +0100
Subject: [PATCH 10/16] Fix breakableFill.

---
 .../Language/Symantic/Document/Plain.hs       | 12 +--
 .../Language/Symantic/Document/Sym.hs         | 82 ++++++++++++-------
 .../Language/Symantic/Document/Valid.hs       |  1 +
 symantic-document/test/HUnit.hs               |  6 +-
 4 files changed, 65 insertions(+), 36 deletions(-)

diff --git a/symantic-document/Language/Symantic/Document/Plain.hs b/symantic-document/Language/Symantic/Document/Plain.hs
index 92766dd..9a75c2d 100644
--- a/symantic-document/Language/Symantic/Document/Plain.hs
+++ b/symantic-document/Language/Symantic/Document/Plain.hs
@@ -78,8 +78,8 @@ instance Monoid Plain where
 instance IsString Plain where
 	fromString = string
 
-plainWrite :: Column Plain -> TLB.Builder -> Plain
-plainWrite len t =
+writeText :: Column Plain -> TLB.Builder -> Plain
+writeText len t =
 	Plain $ \inh st ok ko ->
 		let newCol = st + len in
 		(if newCol <= inh_wrap_column inh then ok else ko)
@@ -87,10 +87,10 @@ plainWrite len t =
 
 instance Doc_Text Plain where
 	empty     = Plain $ \_inh st ok _ko -> ok st ""
-	charH   t = plainWrite 1 $ TLB.singleton t
-	stringH t = plainWrite (List.length t) (fromString t)
-	textH   t = plainWrite (Text.length t) (TLB.fromText t)
-	ltextH  t = plainWrite (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
+	charH   t = writeText 1 $ TLB.singleton t
+	stringH t = writeText (List.length t) (fromString t)
+	textH   t = writeText (Text.length t) (TLB.fromText t)
+	ltextH  t = writeText (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
 	int       = stringH . show
 	integer   = stringH . show
 	replicate cnt p | cnt <= 0  = empty
diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index d1726e6..02ebe43 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -16,10 +16,14 @@ import qualified Data.Text.Lazy as TL
 
 -- * Class 'Doc_Text'
 class (IsString d, Semigroup d) => Doc_Text d where
-	charH     :: Char    -> d -- ^ XXX: MUST NOT be '\n'
-	stringH   :: String  -> d -- ^ XXX: MUST NOT contain '\n'
-	textH     :: Text    -> d -- ^ XXX: MUST NOT contain '\n'
-	ltextH    :: TL.Text -> d -- ^ XXX: MUST NOT contain '\n'
+	charH     :: Char -- ^ XXX: MUST NOT be '\n'
+	          -> d
+	stringH   :: String -- ^ XXX: MUST NOT contain '\n'
+	          -> d
+	textH     :: Text -- ^ XXX: MUST NOT contain '\n'
+	          -> d
+	ltextH    :: TL.Text -- ^ XXX: MUST NOT contain '\n'
+	          -> d
 	replicate :: Int -> d -> d
 	integer   :: Integer -> d
 	default replicate :: Doc_Text (ReprOf d) => Trans d => Int -> d -> d
@@ -38,7 +42,10 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	empty       :: d
 	newline     :: d
 	space       :: d
+	-- | @x '<+>' y = x '<>' 'space' '<>' y@
 	(<+>)       :: d -> d -> d
+	-- | @x '</>' y = x '<>' 'newline' '<>' y@
+	(</>)       :: d -> d -> d
 	int         :: Int -> d
 	char        :: Char    -> d
 	string      :: String  -> d
@@ -54,6 +61,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	newline  = "\n"
 	space    = char ' '
 	x <+> y  = x <> space <> y
+	x </> y  = x <> newline <> y
 	int      = integer . toInteger
 	char     = \case '\n' -> newline; c -> charH c
 	string   = catV . fmap stringH . L.lines
@@ -62,7 +70,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	catH     = foldr (<>) empty
 	catV     = foldrWith (\x y -> x<>newline<>y)
 	foldrWith f ds  = if null ds then empty else foldr1 f ds
-	foldWith  f = foldrWith (\a acc -> a <> f acc)
+	foldWith  f     = foldrWith $ \a acc -> a <> f acc
 	intercalate sep = foldrWith (\x y -> x<>sep<>y)
 	between o c d = o<>d<>c
 	-- default catH :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
@@ -76,20 +84,20 @@ class Doc_Text d => Doc_Align d where
 	type Column d = Int
 	type Indent d
 	type Indent d = Int
-	-- | @align d@, make @d@ uses current 'Column' as 'Indent' level.
+	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
 	align :: d -> d
-	-- | @hang ind d@, make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
+	-- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
 	hang :: Indent d -> d -> d
 	hang ind = align . incrIndent ind
-	-- | @incrIndent ind d@, make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
+	-- | @('incrIndent' ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
 	incrIndent  :: Indent d -> d -> d
-	-- | @withIndent ind d@, make @d@ uses @ind@ as 'Indent' level.
+	-- | @('withIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.
 	withIndent  :: Indent d -> d -> d
-	-- | @withNewline nl d@, make @d@ uses @nl@ as 'newline'.
+	-- | @('withNewline' nl d)@ make @d@ uses @nl@ as 'newline'.
 	withNewline :: d -> d -> d
-	-- | @column f@, return @f@ applied to the current 'Column'.
+	-- | @('column' f)@ returns @f@ applied to the current 'Column'.
 	column :: (Column d -> d) -> d
-	-- | @endToEndWidth d f@, return @d@ concatenated to
+	-- | @('endToEndWidth' d f)@ returns @d@ concatenated to
 	-- @f@ applied to the difference between the end 'Column' and start 'Column' of @d@.
 	--
 	-- Note that @f@ is given the end-to-end width,
@@ -101,11 +109,13 @@ class Doc_Text d => Doc_Align d where
 	endToEndWidth :: d -> (Column d -> d) -> d
 	endToEndWidth d f = column $ \c1 -> (d <>) $ column $ \c2 -> f $ c2 - c1
 	
-	-- | @spaces ind@, replicates 'space' @ind@ times.
+	-- | @'spaces' ind = 'replicate' ind 'space'@
 	default spaces :: Indent d ~ Int => Indent d -> d
 	spaces :: Indent d -> d
 	spaces i = replicate i space
 	
+	-- | @('fill' ind d)@ returns @d@ then as many 'space's as needed
+	-- so that the whole is @ind@ 'Column's wide.
 	default fill ::
 	 Indent d ~ Int =>
 	 Column d ~ Int =>
@@ -117,47 +127,61 @@ class Doc_Text d => Doc_Align d where
 			 LT -> spaces $ m - w
 			 _  -> empty
 	
+	-- | @('breakableFill' ind f d)@ returns @f@ then as many 'space's as needed
+	-- so that the whole is @ind@ 'Column's wide,
+	-- then, if @f@ is not wider than @ind@, appends @d@,
+	-- otherwise appends a 'newline' and @d@,
+	-- with an 'Indent' level set to the start 'Column' of @f@ plus @ind@.
 	default breakableFill ::
 	 Indent d ~ Int =>
 	 Column d ~ Int =>
-	 Indent d -> d -> d
-	breakableFill :: Indent d -> d -> d
-	breakableFill m d =
-		endToEndWidth d $ \w ->
+	 Indent d -> d -> d -> d
+	breakableFill :: Indent d -> d -> d -> d
+	breakableFill m f d =
+		column $ \c ->
+		endToEndWidth f $ \w ->
 			case w`compare`m of
-			 LT -> spaces $ m - w
-			 EQ -> empty
-			 GT -> incrIndent m newline
+			 LT -> spaces (m - w) <> d
+			 EQ -> d
+			 GT -> withIndent (c + m) (newline <> d)
 
 -- * Class 'Doc_Wrap'
 class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
-	-- | @ifFit onFit onNoFit@,
+	-- | @('ifFit' onFit onNoFit)@
 	-- return @onFit@ if @onFit@ leads to a 'Column'
 	-- lower or equal to the one sets with 'withWrapColumn',
 	-- otherwise return @onNoFit@.
 	ifFit :: d -> d -> d
-	-- | @breakpoint onNoBreak onBreak d@,
+	-- | @('breakpoint' onNoBreak onBreak d)@
 	-- return @onNoBreak@ then @d@ if they fit,
 	-- @onBreak@ otherwise.
 	breakpoint :: d -> d -> d -> d
-	-- | @breakableEmpty d@, return @d@ if it fits, 'newline' then @d@ otherwise.
+	-- | @('breakableEmpty' d)@ returns @d@ if it fits, 'newline' then @d@ otherwise.
 	breakableEmpty :: d -> d
 	breakableEmpty = breakpoint empty newline
-	-- | @breakableSpace d@, return 'space' then @d@ it they fit, 'newline' then @d@ otherwise.
+	-- | @x '><' y = x '<>' 'breakableEmpty' y@
+	(><) :: d -> d -> d
+	x >< y = x <> breakableEmpty y
+	-- | @('breakableSpace' d)@ returns 'space' then @d@ it they fit,
+	-- 'newline' then @d@ otherwise.
 	breakableSpace :: d -> d
 	breakableSpace = breakpoint space newline
-	-- | @breakableSpaces ds@ intercalate a 'breakableSpace' between items of @ds@.
+	-- | @x '>+<' y = x '<>' 'breakableSpace' y@
+	(>+<) :: d -> d -> d
+	x >+< y = x <> breakableSpace y
+	-- | @'breakableSpaces' ds@ intercalate a 'breakableSpace'
+	-- between items of @ds@.
 	breakableSpaces :: Foldable f => f d -> d
 	breakableSpaces = foldWith breakableSpace
-	-- | @withWrapColumn col d@ set the 'Column' triggering wrapping to @col@ within @d@.
+	-- | @'withWrapColumn' col d@ set the 'Column' triggering wrapping to @col@ within @d@.
 	withWrapColumn :: Column d -> d -> d
-	-- | @intercalateHorV sep ds@,
+	-- | @('intercalateHorV' sep ds)@
 	-- return @ds@ with @sep@ intercalated if the whole fits,
 	-- otherwise return 'align' of @ds@ with 'newline' and @sep@ intercalated.
 	intercalateHorV :: Foldable f => d -> f d -> d
 	intercalateHorV sep xs =
-		ifFit    (foldr1 (\a acc -> a <> sep            <> acc) xs)
-		 (align $ foldr1 (\a acc -> a <> newline <> sep <> acc) xs)
+		ifFit (foldWith (sep <>) xs)
+		 (align $ foldWith ((newline <> sep) <>) xs)
 
 -- * Class 'Doc_Color'
 class Doc_Color d where
diff --git a/symantic-document/Language/Symantic/Document/Valid.hs b/symantic-document/Language/Symantic/Document/Valid.hs
index e69b7f4..bb4209c 100644
--- a/symantic-document/Language/Symantic/Document/Valid.hs
+++ b/symantic-document/Language/Symantic/Document/Valid.hs
@@ -58,6 +58,7 @@ instance Monad Valid where
 instance (Doc_Text repr, Semigroup repr) => Doc_Text (Valid repr) where
 	replicate i _ | i < 0 = KO [Error_Valid_negative_replicate i]
 	replicate i d         = d >>= Ok . replicate i
+	empty     = pure empty
 	int       = pure . int
 	integer   = pure . integer
 	char      = pure . char
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 5aad25e..606bd29 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -68,11 +68,15 @@ hunitsPlain = testGroup "Plain"
                           , ("abcdefghi","Doc") ])
      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi :: Doc"
    , "let " <> Doc.align (Doc.catV $
-               (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
+               (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) $ " ::" <+> Doc.stringH typ)
                `List.map` [ ("abcdef","Doc")
                           , ("abcde","Int -> Doc -> Doc")
                           , ("abcdefghi","Doc") ])
      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi\n           :: Doc"
+   , "let " <> Doc.align (Doc.catV $
+               (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) $ " ::" <+> typ)
+               `List.map` [("abcdefghi","Doc ->\nDoc")])
+     ==> "let abcdefghi\n           :: Doc ->\n          Doc"
    ]
  , testList "Doc_Wrap"
    [ 10`wc` be ["hello", "world"] ==> "helloworld"
-- 
2.44.1


From 01232b112bbbcdb01bb52bc7d2ec77e27b0924c6 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Wed, 7 Mar 2018 04:04:41 +0100
Subject: [PATCH 11/16] Reorganize symantic-document modules.

---
 .../Language/Symantic/Document.hs             |  11 -
 .../Language/Symantic/Document/Dim.hs         | 143 -----------
 .../Language/Symantic/Document/Plain.hs       | 243 ------------------
 .../Language/Symantic/Document/Sym.hs         |  30 ++-
 .../Language/Symantic/Document/Term.hs        | 172 +++++++++++++
 .../Language/Symantic/Document/Term/Dim.hs    | 190 ++++++++++++++
 .../Language/Symantic/Document/Term/IO.hs     | 172 +++++++++++++
 .../Language/Symantic/Document/Valid.hs       | 113 --------
 symantic-document/symantic-document.cabal     |   8 +-
 symantic-document/test/HUnit.hs               |  23 +-
 10 files changed, 570 insertions(+), 535 deletions(-)
 delete mode 100644 symantic-document/Language/Symantic/Document.hs
 delete mode 100644 symantic-document/Language/Symantic/Document/Dim.hs
 delete mode 100644 symantic-document/Language/Symantic/Document/Plain.hs
 create mode 100644 symantic-document/Language/Symantic/Document/Term.hs
 create mode 100644 symantic-document/Language/Symantic/Document/Term/Dim.hs
 create mode 100644 symantic-document/Language/Symantic/Document/Term/IO.hs
 delete mode 100644 symantic-document/Language/Symantic/Document/Valid.hs

diff --git a/symantic-document/Language/Symantic/Document.hs b/symantic-document/Language/Symantic/Document.hs
deleted file mode 100644
index d7f19bd..0000000
--- a/symantic-document/Language/Symantic/Document.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Language.Symantic.Document
- ( module Language.Symantic.Document.Sym
- , module Language.Symantic.Document.Dim
- , module Language.Symantic.Document.Plain
- , module Language.Symantic.Document.Valid
- ) where
-
-import Language.Symantic.Document.Sym
-import Language.Symantic.Document.Dim
-import Language.Symantic.Document.Plain
-import Language.Symantic.Document.Valid
diff --git a/symantic-document/Language/Symantic/Document/Dim.hs b/symantic-document/Language/Symantic/Document/Dim.hs
deleted file mode 100644
index bb6453f..0000000
--- a/symantic-document/Language/Symantic/Document/Dim.hs
+++ /dev/null
@@ -1,143 +0,0 @@
-module Language.Symantic.Document.Dim where
-
-{-
-import Control.Applicative (Applicative(..))
-import Control.Monad (Monad(..))
-import Data.Bool
-import Data.Eq (Eq(..))
-import Data.Foldable (Foldable(..))
-import Data.Function (($), id)
-import Data.Functor ((<$>), ($>))
-import Data.Int (Int)
-import Data.Monoid (Monoid(..))
-import Data.Ord (Ord(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (IsString(..))
-import Prelude (max, Num(..), toInteger)
-import Text.Show (Show(..))
-import qualified Data.List as L
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Control.Monad.Trans.State as S
-
-import Language.Symantic.Document.Sym
-
--- * Type 'Dim'
-data Dim
- =   Dim
- {   dim_width       :: Int -- ^ Maximun line length.
- ,   dim_height      :: Int -- ^ Number of newlines.
- ,   dim_width_first :: Int -- ^ Length of the first line.
- ,   dim_width_last  :: Int -- ^ Length of the last line.
- } deriving (Eq, Show)
-instance Semigroup Dim where
-	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
-	 Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
-		let h = hx + hy in
-		case (hx, hy) of
-		 (0, 0) -> let w = wx  + wy  in Dim w h w w
-		 (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
-		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
-		 _      -> Dim (max wx wy) h wfx wly
-instance Monoid Dim where
-	mempty  = Dim 0 0 0 0
-	mappend = (<>)
-
--- * Type 'Dimension'
-newtype Dimension = Dimension { unDimension :: Inh -> S.State Column Dim }
-
-instance IsString Dimension where
-	fromString [] = mempty
-	fromString s =
-		Dimension $ \inh ->
-			let ls = L.lines s in
-			return $
-			case inh_newline inh of
-			 NewlineEmpty ->
-				let w = sum $ length <$> ls in
-				Dim
-				 { dim_width       = w
-				 , dim_height      = 0
-				 , dim_width_first = w
-				 , dim_width_last  = w
-				 }
-			 NewlineWithIndent ->
-				let ws = case length <$> ls of [] -> []; c:cs -> c : ((inh_indent inh +)<$>cs) in
-				Dim
-				 { dim_width       = maximum ws
-				 , dim_height      = length ls
-				 , dim_width_first = if null ws then 0 else L.head ws
-				 , dim_width_last  = if null ws then 0 else L.last ws
-				 }
-			 NewlineWithoutIndent ->
-				let ws = length <$> ls in
-				Dim
-				 { dim_width       = maximum ws
-				 , dim_height      = length ls
-				 , dim_width_first = if null ws then 0 else L.head ws
-				 , dim_width_last  = if null ws then 0 else L.last ws
-				 }
-
-dimension :: Dimension -> Dimension
-dimension = id
-
-
-instance Semigroup Dimension where
-	-- Dimension x <> Dimension y = Dimension (x <> y)
-	Dimension x <> Dimension y = Dimension (\inh -> (<>) <$> x inh <*> y inh)
-instance Monoid Dimension where
-	mempty  = empty
-	mappend = (<>)
-instance Doc_Text Dimension where
-	spaces    i   = Dimension $ \_inh -> return $ Dim i 0 i i
-	replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
-	int       i   = stringH $ show i
-	integer   i   = stringH $ show i
-	empty         = Dimension $ \_inh -> return mempty
-	newline       = Dimension $ \_inh -> return $ Dim 0 1 0 0
-	charH     _c  = incrColumn $ 1
-	stringH   t   = incrColumn $ length t
-	textH     t   = incrColumn $ T.length t
-	ltextH    t   = incrColumn $ fromInteger $ toInteger $ TL.length t
-	                                    -- XXX: conversion may overflow
-instance Doc_Color Dimension where
-	reverse     = id
-	black       = id
-	red         = id
-	green       = id
-	yellow      = id
-	blue        = id
-	magenta     = id
-	cyan        = id
-	white       = id
-	blacker     = id
-	redder      = id
-	greener     = id
-	yellower    = id
-	bluer       = id
-	magentaer   = id
-	cyaner      = id
-	whiter      = id
-	onBlack     = id
-	onRed       = id
-	onGreen     = id
-	onYellow    = id
-	onBlue      = id
-	onMagenta   = id
-	onCyan      = id
-	onWhite     = id
-	onBlacker   = id
-	onRedder    = id
-	onGreener   = id
-	onYellower  = id
-	onBluer     = id
-	onMagentaer = id
-	onCyaner    = id
-	onWhiter    = id
-instance Doc_Decoration Dimension where
-	bold        = id
-	underline   = id
-	italic      = id
-instance Doc_Align Dimension where
-instance Doc_Wrap Dimension where
--}
diff --git a/symantic-document/Language/Symantic/Document/Plain.hs b/symantic-document/Language/Symantic/Document/Plain.hs
deleted file mode 100644
index 9a75c2d..0000000
--- a/symantic-document/Language/Symantic/Document/Plain.hs
+++ /dev/null
@@ -1,243 +0,0 @@
-module Language.Symantic.Document.Plain where
-
-import Control.Applicative (Applicative(..))
-import Data.Bool
-import Data.Int (Int)
-import Data.Function (($), (.), id)
-import Data.Monoid (Monoid(..))
-import Data.Ord (Ord(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (IsString(..))
-import Prelude ((+), pred)
-import GHC.Exts (IsList(..))
-import System.Console.ANSI
-import Text.Show (Show(..))
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TLB
--- import qualified Data.Text.Lazy.IO as TL
--- import qualified System.IO as IO
-
-import Language.Symantic.Document.Sym
-
--- * Type 'Inh'
-data Inh
- =   Inh
- {   inh_indent      :: !(Indent Plain) -- ^ Current indentation level, used by 'newline'.
- ,   inh_newline     :: Plain           -- ^ How to display 'newline'.
- ,   inh_wrap_column :: !(Column Plain) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
- ,   inh_sgr         :: ![SGR]          -- ^ Active ANSI codes.
- }
-
-defInh :: Inh
-defInh = Inh
- { inh_indent      = 0
- , inh_newline     = newlineWithIndent
- , inh_wrap_column = 80
- , inh_sgr         = []
- }
-
--- * Type 'State'
-type State = Column Plain
-
-defState :: State
-defState = 0
-
--- * Type 'Plain'
-newtype Plain
- =      Plain
- {    unPlain :: Inh -> State
-              -> (State -> TLB.Builder -> TLB.Builder) -- normal   continuation
-              -> (State -> TLB.Builder -> TLB.Builder) -- wrapping continuation
-              -> TLB.Builder }
-
-buildPlain :: Plain -> TLB.Builder
-buildPlain (Plain p) = p defInh defState oko oko
-	where oko _st = id
-
-textPlain :: Plain -> TL.Text
-textPlain = TLB.toLazyText . buildPlain
-
-instance IsList Plain where
-	type Item Plain = Plain
-	fromList = mconcat
-	toList   = pure
-instance Semigroup Plain where
-	x <> y = Plain $ \inh st ok ko ->
-		unPlain x inh st
-		 (\sx tx -> unPlain y inh sx
-			 (\sy ty -> ok sy (tx<>ty))
-			 (\sy ty -> ko sy (tx<>ty)))
-		 (\sx tx -> unPlain y inh sx
-			 (\sy ty -> ko sy (tx<>ty))
-			 (\sy ty -> ko sy (tx<>ty)))
-instance Monoid Plain where
-	mempty  = empty
-	mappend = (<>)
-instance IsString Plain where
-	fromString = string
-
-writeText :: Column Plain -> TLB.Builder -> Plain
-writeText len t =
-	Plain $ \inh st ok ko ->
-		let newCol = st + len in
-		(if newCol <= inh_wrap_column inh then ok else ko)
-		newCol t
-
-instance Doc_Text Plain where
-	empty     = Plain $ \_inh st ok _ko -> ok st ""
-	charH   t = writeText 1 $ TLB.singleton t
-	stringH t = writeText (List.length t) (fromString t)
-	textH   t = writeText (Text.length t) (TLB.fromText t)
-	ltextH  t = writeText (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
-	int       = stringH . show
-	integer   = stringH . show
-	replicate cnt p | cnt <= 0  = empty
-	                | otherwise = p <> replicate (pred cnt) p
-	newline = Plain $ \inh -> unPlain (inh_newline inh) inh
-
-newlineWithoutIndent :: Plain
-newlineWithoutIndent = Plain $ \_inh _st ok _ko ->
-	ok 0 $ TLB.singleton '\n'
-
-newlineWithIndent :: Plain
-newlineWithIndent = Plain $ \inh _st ok _ko ->
-	ok (inh_indent inh) $
-		TLB.singleton '\n' <>
-		fromString (List.replicate (inh_indent inh) ' ')
-
-instance Doc_Align Plain where
-	type Column Plain = Int
-	type Indent Plain = Int
-	align p = Plain $ \inh st -> unPlain p inh{inh_indent=st} st
-	withNewline nl  p = Plain $ \inh -> unPlain p inh{inh_newline=nl}
-	withIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=ind}
-	incrIndent  ind p = Plain $ \inh -> unPlain p inh{inh_indent=inh_indent inh + ind}
-	column f = Plain $ \inh st -> unPlain (f st) inh st
-instance Doc_Wrap Plain where
-	ifFit x y = Plain $ \inh st ok ko ->
-		unPlain x inh st ok (\_sx _tx -> unPlain y inh st ok ko)
-	breakpoint onNoBreak onBreak p = Plain $ \inh st ok ko ->
-		unPlain (onNoBreak <> p) inh st ok
-		 (\_sp _tp -> unPlain (onBreak <> p) inh st ok ko)
-	withWrapColumn col p = Plain $ \inh -> unPlain p inh{inh_wrap_column=col}
-
-writeSGR :: SGR -> Plain -> Plain
-writeSGR s p = Plain $ \inh@Inh{inh_sgr=ss} st ok ko ->
-	let o = Plain $ \_inh st' ok' _ko -> ok' st' $ fromString $ setSGRCode [s] in
-	let c :: TLB.Builder = fromString $ setSGRCode $ Reset:List.reverse ss in
-	unPlain (o<>p) inh{inh_sgr=s:ss} st
-	 (\_st t -> ok st $ t<>c)
-	 (\_st t -> ko st $ t<>c)
-
-instance Doc_Color Plain where
-	reverse     = writeSGR $ SetSwapForegroundBackground True
-	black       = writeSGR $ SetColor Foreground Dull  Black
-	red         = writeSGR $ SetColor Foreground Dull  Red
-	green       = writeSGR $ SetColor Foreground Dull  Green
-	yellow      = writeSGR $ SetColor Foreground Dull  Yellow
-	blue        = writeSGR $ SetColor Foreground Dull  Blue
-	magenta     = writeSGR $ SetColor Foreground Dull  Magenta
-	cyan        = writeSGR $ SetColor Foreground Dull  Cyan
-	white       = writeSGR $ SetColor Foreground Dull  White
-	blacker     = writeSGR $ SetColor Foreground Vivid Black
-	redder      = writeSGR $ SetColor Foreground Vivid Red
-	greener     = writeSGR $ SetColor Foreground Vivid Green
-	yellower    = writeSGR $ SetColor Foreground Vivid Yellow
-	bluer       = writeSGR $ SetColor Foreground Vivid Blue
-	magentaer   = writeSGR $ SetColor Foreground Vivid Magenta
-	cyaner      = writeSGR $ SetColor Foreground Vivid Cyan
-	whiter      = writeSGR $ SetColor Foreground Vivid White
-	onBlack     = writeSGR $ SetColor Background Dull  Black
-	onRed       = writeSGR $ SetColor Background Dull  Red
-	onGreen     = writeSGR $ SetColor Background Dull  Green
-	onYellow    = writeSGR $ SetColor Background Dull  Yellow
-	onBlue      = writeSGR $ SetColor Background Dull  Blue
-	onMagenta   = writeSGR $ SetColor Background Dull  Magenta
-	onCyan      = writeSGR $ SetColor Background Dull  Cyan
-	onWhite     = writeSGR $ SetColor Background Dull  White
-	onBlacker   = writeSGR $ SetColor Background Vivid Black
-	onRedder    = writeSGR $ SetColor Background Vivid Red
-	onGreener   = writeSGR $ SetColor Background Vivid Green
-	onYellower  = writeSGR $ SetColor Background Vivid Yellow
-	onBluer     = writeSGR $ SetColor Background Vivid Blue
-	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
-	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
-	onWhiter    = writeSGR $ SetColor Background Vivid White
-instance Doc_Decoration Plain where
-	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
-	underline   = writeSGR $ SetUnderlining SingleUnderline
-	italic      = writeSGR $ SetItalicized True
-
-
-
-
-{-
--- * Type 'PlainIO'
-newtype PlainIO
- =      PlainIO { unPlainIO :: IO.Handle -> IO () }
-instance IsString PlainIO where
-	fromString s = PlainIO $ \h -> IO.hPutStr h s
-
-plainIO :: PlainIO -> IO.Handle -> IO ()
-plainIO (PlainIO d) = d
-
-instance Semigroup PlainIO where
-	PlainIO x <> PlainIO y = PlainIO $ \h -> do {x h; y h}
-instance Monoid PlainIO where
-	mempty  = empty
-	mappend = (<>)
-instance Doc_Text PlainIO where
-	empty         = PlainIO $ \_ -> return ()
-	int     i     = PlainIO $ \h -> IO.hPutStr  h (show i)
-	integer i     = PlainIO $ \h -> IO.hPutStr  h (show i)
-	replicate i d = PlainIO $ replicateM_ i . plainIO d
-	charH   x     = PlainIO $ \h -> IO.hPutChar h x
-	stringH x     = PlainIO $ \h -> IO.hPutStr  h x
-	textH   x     = PlainIO $ \h -> Text.hPutStr h x
-	ltextH  x     = PlainIO $ \h -> TL.hPutStr  h x
-	-- NOTE: PlainIO has no support for indentation, hence char = charH, etc.
-	char          = charH
-	string        = stringH
-	text          = textH
-	ltext         = ltextH
-instance Doc_Color PlainIO where
-	reverse       = id
-	black         = id
-	red           = id
-	green         = id
-	yellow        = id
-	blue          = id
-	magenta       = id
-	cyan          = id
-	white         = id
-	blacker       = id
-	redder        = id
-	greener       = id
-	yellower      = id
-	bluer         = id
-	magentaer     = id
-	cyaner        = id
-	whiter        = id
-	onBlack       = id
-	onRed         = id
-	onGreen       = id
-	onYellow      = id
-	onBlue        = id
-	onMagenta     = id
-	onCyan        = id
-	onWhite       = id
-	onBlacker     = id
-	onRedder      = id
-	onGreener     = id
-	onYellower    = id
-	onBluer       = id
-	onMagentaer   = id
-	onCyaner      = id
-	onWhiter      = id
-instance Doc_Decoration PlainIO where
-	bold          = id
-	underline     = id
-	italic        = id
--}
diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 02ebe43..22e8c9e 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -1,6 +1,7 @@
 module Language.Symantic.Document.Sym where
 
 import Data.Char (Char)
+import Data.Eq (Eq(..))
 import Data.Foldable (Foldable(..))
 import Data.Function ((.), ($))
 import Data.Functor (Functor(..))
@@ -10,10 +11,16 @@ import Data.Semigroup (Semigroup(..))
 import Data.String (String, IsString)
 import Data.Text (Text)
 import Prelude (Integer, toInteger, fromIntegral, Num(..))
-import qualified Data.List as L
-import qualified Data.Text as T
+import qualified Data.List as List
+import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 
+-- * Type family 'Column'
+type family Column (d:: *) :: *
+
+-- * Type family 'Indent'
+type family Indent (d:: *) :: *
+
 -- * Class 'Doc_Text'
 class (IsString d, Semigroup d) => Doc_Text d where
 	charH     :: Char -- ^ XXX: MUST NOT be '\n'
@@ -64,8 +71,8 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	x </> y  = x <> newline <> y
 	int      = integer . toInteger
 	char     = \case '\n' -> newline; c -> charH c
-	string   = catV . fmap stringH . L.lines
-	text     = catV . fmap textH   . T.lines
+	string   = catV . fmap stringH . lines
+	text     = catV . fmap textH   . Text.lines
 	ltext    = catV . fmap ltextH  . TL.lines
 	catH     = foldr (<>) empty
 	catV     = foldrWith (\x y -> x<>newline<>y)
@@ -80,10 +87,6 @@ class (IsString d, Semigroup d) => Doc_Text d where
 
 -- * Class 'Doc_Align'
 class Doc_Text d => Doc_Align d where
-	type Column d
-	type Column d = Int
-	type Indent d
-	type Indent d = Int
 	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
 	align :: d -> d
 	-- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
@@ -94,7 +97,11 @@ class Doc_Text d => Doc_Align d where
 	-- | @('withIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.
 	withIndent  :: Indent d -> d -> d
 	-- | @('withNewline' nl d)@ make @d@ uses @nl@ as 'newline'.
+	--
+	-- Useful values for @nl@ are: 'empty', 'newlineWithIndent', 'newlineWithoutIndent'.
 	withNewline :: d -> d -> d
+	newlineWithoutIndent :: d
+	newlineWithIndent    :: d
 	-- | @('column' f)@ returns @f@ applied to the current 'Column'.
 	column :: (Column d -> d) -> d
 	-- | @('endToEndWidth' d f)@ returns @d@ concatenated to
@@ -340,3 +347,10 @@ int64OfInt = fromIntegral
 
 intOfInt64 :: Int64 -> Int
 intOfInt64 = fromIntegral
+
+-- | Break a 'String' into lines while preserving all empty lines.
+lines :: String -> [String]
+lines cs =
+	case List.break (== '\n') cs of
+	 (chunk, _:rest) -> chunk : lines rest
+	 (chunk, []) -> [chunk]
diff --git a/symantic-document/Language/Symantic/Document/Term.hs b/symantic-document/Language/Symantic/Document/Term.hs
new file mode 100644
index 0000000..362f5e3
--- /dev/null
+++ b/symantic-document/Language/Symantic/Document/Term.hs
@@ -0,0 +1,172 @@
+module Language.Symantic.Document.Term
+ ( module Language.Symantic.Document.Sym
+ , module Language.Symantic.Document.Term
+ ) where
+
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Function (($), (.), id)
+import Data.Int (Int)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (IsString(..))
+import GHC.Exts (IsList(..))
+import Prelude ((+), pred)
+import System.Console.ANSI
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TLB
+
+import Language.Symantic.Document.Sym
+
+-- * Type 'Reader'
+data Reader
+ =   Reader
+ {   reader_indent      :: !(Indent Term) -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: Term           -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !(Column Term) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_sgr         :: ![SGR]         -- ^ Active ANSI codes.
+ }
+
+-- | Default 'Reader'.
+defReader :: Reader
+defReader = Reader
+ { reader_indent      = 0
+ , reader_newline     = newlineWithIndent
+ , reader_wrap_column = 80
+ , reader_sgr         = []
+ }
+
+-- * Type 'State'
+type State = Column Term
+
+-- | Default 'State'.
+defState :: State
+defState = 0
+
+-- * Type 'Term'
+newtype Term
+ =      Term
+ {    unTerm :: Reader ->
+                State  ->
+                (State -> TLB.Builder -> TLB.Builder) -> -- normal continuation
+                (State -> TLB.Builder -> TLB.Builder) -> -- should-wrap continuation
+                TLB.Builder }
+
+type instance Column Term = Int
+type instance Indent Term = Int
+
+-- | Render a 'Term' into a 'TL.Text'.
+textTerm :: Term -> TL.Text
+textTerm = TLB.toLazyText . buildTerm
+
+-- | Render a 'Term' into a 'TLB.Builder'.
+buildTerm :: Term -> TLB.Builder
+buildTerm (Term p) = p defReader defState oko oko
+	where oko _st = id
+
+instance IsList Term where
+	type Item Term = Term
+	fromList = mconcat
+	toList   = pure
+instance Semigroup Term where
+	x <> y = Term $ \ro st ok ko ->
+		unTerm x ro st
+		 (\sx tx -> unTerm y ro sx
+			 (\sy ty -> ok sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+		 (\sx tx -> unTerm y ro sx
+			 (\sy ty -> ko sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+instance Monoid Term where
+	mempty  = empty
+	mappend = (<>)
+instance IsString Term where
+	fromString = string
+
+writeH :: Column Term -> TLB.Builder -> Term
+writeH len t =
+	Term $ \ro st ok ko ->
+		let newCol = st + len in
+		(if newCol <= reader_wrap_column ro then ok else ko)
+		newCol t
+
+instance Doc_Text Term where
+	empty     = Term $ \_ro st ok _ko -> ok st mempty
+	charH   t = writeH 1 $ TLB.singleton t
+	stringH t = writeH (List.length t) (fromString t)
+	textH   t = writeH (Text.length t) (TLB.fromText t)
+	ltextH  t = writeH (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
+	int       = stringH . show
+	integer   = stringH . show
+	replicate cnt p | cnt <= 0  = empty
+	                | otherwise = p <> replicate (pred cnt) p
+	newline = Term $ \ro -> unTerm (reader_newline ro) ro
+instance Doc_Align Term where
+	align p = Term $ \ro st -> unTerm p ro{reader_indent=st} st
+	withNewline nl  p = Term $ \ro -> unTerm p ro{reader_newline=nl}
+	withIndent  ind p = Term $ \ro -> unTerm p ro{reader_indent=ind}
+	incrIndent  ind p = Term $ \ro -> unTerm p ro{reader_indent=reader_indent ro + ind}
+	column f = Term $ \ro st -> unTerm (f st) ro st
+	newlineWithoutIndent = Term $ \_ro _st ok _ko ->
+		ok 0 $ TLB.singleton '\n'
+	newlineWithIndent = Term $ \ro _st ok _ko ->
+		ok (reader_indent ro) $
+			TLB.singleton '\n' <>
+			fromString (List.replicate (reader_indent ro) ' ')
+instance Doc_Wrap Term where
+	ifFit x y = Term $ \ro st ok ko ->
+		unTerm x ro st ok (\_sx _tx -> unTerm y ro st ok ko)
+	breakpoint onNoBreak onBreak p = Term $ \ro st ok ko ->
+		unTerm (onNoBreak <> p) ro st ok
+		 (\_sp _tp -> unTerm (onBreak <> p) ro st ok ko)
+	withWrapColumn col p = Term $ \ro -> unTerm p ro{reader_wrap_column=col}
+
+writeSGR :: SGR -> Term -> Term
+writeSGR s p = o <> m <> c
+	where
+	o = Term $ \_ro st ok _ko -> ok st $ fromString $ setSGRCode [s]
+	m = Term $ \ro -> unTerm p ro{reader_sgr=s:reader_sgr ro}
+	c = Term $ \ro st ok _ko -> ok st $ fromString $ setSGRCode $ Reset:List.reverse (reader_sgr ro)
+
+instance Doc_Color Term where
+	reverse     = writeSGR $ SetSwapForegroundBackground True
+	black       = writeSGR $ SetColor Foreground Dull  Black
+	red         = writeSGR $ SetColor Foreground Dull  Red
+	green       = writeSGR $ SetColor Foreground Dull  Green
+	yellow      = writeSGR $ SetColor Foreground Dull  Yellow
+	blue        = writeSGR $ SetColor Foreground Dull  Blue
+	magenta     = writeSGR $ SetColor Foreground Dull  Magenta
+	cyan        = writeSGR $ SetColor Foreground Dull  Cyan
+	white       = writeSGR $ SetColor Foreground Dull  White
+	blacker     = writeSGR $ SetColor Foreground Vivid Black
+	redder      = writeSGR $ SetColor Foreground Vivid Red
+	greener     = writeSGR $ SetColor Foreground Vivid Green
+	yellower    = writeSGR $ SetColor Foreground Vivid Yellow
+	bluer       = writeSGR $ SetColor Foreground Vivid Blue
+	magentaer   = writeSGR $ SetColor Foreground Vivid Magenta
+	cyaner      = writeSGR $ SetColor Foreground Vivid Cyan
+	whiter      = writeSGR $ SetColor Foreground Vivid White
+	onBlack     = writeSGR $ SetColor Background Dull  Black
+	onRed       = writeSGR $ SetColor Background Dull  Red
+	onGreen     = writeSGR $ SetColor Background Dull  Green
+	onYellow    = writeSGR $ SetColor Background Dull  Yellow
+	onBlue      = writeSGR $ SetColor Background Dull  Blue
+	onMagenta   = writeSGR $ SetColor Background Dull  Magenta
+	onCyan      = writeSGR $ SetColor Background Dull  Cyan
+	onWhite     = writeSGR $ SetColor Background Dull  White
+	onBlacker   = writeSGR $ SetColor Background Vivid Black
+	onRedder    = writeSGR $ SetColor Background Vivid Red
+	onGreener   = writeSGR $ SetColor Background Vivid Green
+	onYellower  = writeSGR $ SetColor Background Vivid Yellow
+	onBluer     = writeSGR $ SetColor Background Vivid Blue
+	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
+	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
+	onWhiter    = writeSGR $ SetColor Background Vivid White
+instance Doc_Decoration Term where
+	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
+	underline   = writeSGR $ SetUnderlining SingleUnderline
+	italic      = writeSGR $ SetItalicized True
diff --git a/symantic-document/Language/Symantic/Document/Term/Dim.hs b/symantic-document/Language/Symantic/Document/Term/Dim.hs
new file mode 100644
index 0000000..54734b7
--- /dev/null
+++ b/symantic-document/Language/Symantic/Document/Term/Dim.hs
@@ -0,0 +1,190 @@
+module Language.Symantic.Document.Term.Dim
+ ( module Language.Symantic.Document.Sym
+ , module Language.Symantic.Document.Term.Dim
+ ) where
+
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Eq (Eq(..))
+import Data.Function (($), (.), id)
+import Data.Int (Int)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (IsString(..))
+import GHC.Exts (IsList(..))
+import Prelude ((+), pred)
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
+
+import Language.Symantic.Document.Sym
+
+-- * Type 'Dim'
+data Dim
+ =   Dim
+ {   dim_width       :: Int -- ^ Maximun line length.
+ ,   dim_height      :: Int -- ^ Number of newlines.
+ ,   dim_width_first :: Int -- ^ Length of the first line.
+ ,   dim_width_last  :: Int -- ^ Length of the last line.
+ } deriving (Eq, Show)
+instance Semigroup Dim where
+	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
+	 Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
+		let h = hx + hy in
+		case (hx, hy) of
+		 (0, 0) -> let w = wx  + wy  in Dim w h w w
+		 (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
+		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
+		 _      -> Dim (max wx wy) h wfx wly
+instance Monoid Dim where
+	mempty  = Dim 0 0 0 0
+	mappend = (<>)
+
+-- * Type 'Reader'
+data Reader
+ =   Reader
+ {   reader_indent      :: !(Indent Dimension) -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: Dimension           -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !(Column Dimension) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ }
+
+-- | Default 'Reader'.
+defReader :: Reader
+defReader = Reader
+ { reader_indent      = 0
+ , reader_newline     = newlineWithIndent
+ , reader_wrap_column = 80
+ }
+
+-- * Type 'State'
+type State = Column Dimension
+
+defState :: State
+defState = 0
+
+-- * Type 'Dimension'
+newtype Dimension
+ =      Dimension
+ {    unDimension :: Reader ->
+                     State  ->
+                     (State -> Dim -> Dim) -> -- normal continuation
+                     (State -> Dim -> Dim) -> -- should-wrap continuation
+                     Dim }
+type instance Column Dimension = Int
+type instance Indent Dimension = Int
+
+dim :: Dimension -> Dim
+dim (Dimension p) = p defReader defState oko oko
+	where oko _st = id
+
+instance IsList Dimension where
+	type Item Dimension = Dimension
+	fromList = mconcat
+	toList   = pure
+instance Semigroup Dimension where
+	x <> y = Dimension $ \ro st ok ko ->
+		unDimension x ro st
+		 (\sx tx -> unDimension y ro sx
+			 (\sy ty -> ok sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+		 (\sx tx -> unDimension y ro sx
+			 (\sy ty -> ko sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+instance Monoid Dimension where
+	mempty  = empty
+	mappend = (<>)
+instance IsString Dimension where
+	fromString = string
+
+writeH :: Column Dimension -> Dimension
+writeH len =
+	Dimension $ \ro col ok ko ->
+		let newCol = col + len in
+		(if newCol <= reader_wrap_column ro then ok else ko)
+		newCol Dim
+		 { dim_width       = newCol
+		 , dim_height      = 0
+		 , dim_width_last  = newCol
+		 , dim_width_first = newCol
+		 }
+
+instance Doc_Text Dimension where
+	empty     = Dimension $ \_ro st ok _ko -> ok st mempty
+	charH   _ = writeH 1
+	stringH t = writeH $ List.length t
+	textH   t = writeH $ Text.length t
+	ltextH  t = writeH $ intOfInt64 $ TL.length t
+	int       = stringH . show
+	integer   = stringH . show
+	replicate cnt p | cnt <= 0  = empty
+	                | otherwise = p <> replicate (pred cnt) p
+	newline = Dimension $ \ro -> unDimension (reader_newline ro) ro
+instance Doc_Align Dimension where
+	align p = Dimension $ \ro st -> unDimension p ro{reader_indent=st} st
+	withNewline nl  p = Dimension $ \ro -> unDimension p ro{reader_newline=nl}
+	withIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=ind}
+	incrIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=reader_indent ro + ind}
+	column f = Dimension $ \ro st -> unDimension (f st) ro st
+	newlineWithoutIndent = Dimension $ \_ro _st ok _ko ->
+		ok 0 Dim
+		 { dim_width       = 0
+		 , dim_height      = 1
+		 , dim_width_first = 0
+		 , dim_width_last  = 0
+		 }
+	newlineWithIndent = Dimension $ \ro _st ok _ko ->
+		let ind = reader_indent ro in
+		ok ind Dim
+		 { dim_width       = ind
+		 , dim_height      = 1
+		 , dim_width_first = 0
+		 , dim_width_last  = ind
+		 }
+
+instance Doc_Wrap Dimension where
+	ifFit x y = Dimension $ \ro st ok ko ->
+		unDimension x ro st ok (\_sx _tx -> unDimension y ro st ok ko)
+	breakpoint onNoBreak onBreak p = Dimension $ \ro st ok ko ->
+		unDimension (onNoBreak <> p) ro st ok
+		 (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
+	withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
+instance Doc_Color Dimension where
+	reverse     = id
+	black       = id
+	red         = id
+	green       = id
+	yellow      = id
+	blue        = id
+	magenta     = id
+	cyan        = id
+	white       = id
+	blacker     = id
+	redder      = id
+	greener     = id
+	yellower    = id
+	bluer       = id
+	magentaer   = id
+	cyaner      = id
+	whiter      = id
+	onBlack     = id
+	onRed       = id
+	onGreen     = id
+	onYellow    = id
+	onBlue      = id
+	onMagenta   = id
+	onCyan      = id
+	onWhite     = id
+	onBlacker   = id
+	onRedder    = id
+	onGreener   = id
+	onYellower  = id
+	onBluer     = id
+	onMagentaer = id
+	onCyaner    = id
+	onWhiter    = id
+instance Doc_Decoration Dimension where
+	bold      = id
+	underline = id
+	italic    = id
diff --git a/symantic-document/Language/Symantic/Document/Term/IO.hs b/symantic-document/Language/Symantic/Document/Term/IO.hs
new file mode 100644
index 0000000..f6efab7
--- /dev/null
+++ b/symantic-document/Language/Symantic/Document/Term/IO.hs
@@ -0,0 +1,172 @@
+module Language.Symantic.Document.Term.IO
+ ( module Language.Symantic.Document.Sym
+ , module Language.Symantic.Document.Term.IO
+ ) where
+
+import Control.Applicative (Applicative(..))
+import Data.Bool
+import Data.Function (($), (.), id)
+import Data.Int (Int)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (IsString(..))
+import GHC.Exts (IsList(..))
+import Prelude ((+), pred)
+import System.Console.ANSI
+import System.IO (IO)
+import Text.Show (Show(..))
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified System.IO as IO
+
+import Language.Symantic.Document.Sym
+
+-- * Type 'Reader'
+data Reader
+ =   Reader
+ {   reader_indent      :: !(Indent TermIO) -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: TermIO           -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !(Column TermIO) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_sgr         :: ![SGR]           -- ^ Active ANSI codes.
+ ,   reader_handle      :: !IO.Handle       -- ^ Where to write.
+ }
+
+-- | Default 'Reader'.
+defReader :: Reader
+defReader = Reader
+ { reader_indent      = 0
+ , reader_newline     = newlineWithIndent
+ , reader_wrap_column = 80
+ , reader_sgr         = []
+ , reader_handle      = IO.stdout
+ }
+
+-- * Type 'State'
+type State = Column TermIO
+
+-- | Default 'State'.
+defState :: State
+defState = 0
+
+-- * Type 'TermIO'
+newtype TermIO
+ =      TermIO
+ {    unTermIO :: Reader -> State ->
+                  (State -> IO () -> IO ()) -> -- normal continuation
+                  (State -> IO () -> IO ()) -> -- should-wrap continuation
+                  IO () }
+
+type instance Column TermIO = Int
+type instance Indent TermIO = Int
+
+-- | Write a 'TermIO'.
+runTermIO :: IO.Handle -> TermIO -> IO ()
+runTermIO h (TermIO p) = p defReader{reader_handle=h} defState oko oko
+	where oko _st = id
+
+instance IsList TermIO where
+	type Item TermIO = TermIO
+	fromList = mconcat
+	toList   = pure
+instance Semigroup TermIO where
+	x <> y = TermIO $ \ro st ok ko ->
+		unTermIO x ro st
+		 (\sx tx -> unTermIO y ro sx
+			 (\sy ty -> ok sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+		 (\sx tx -> unTermIO y ro sx
+			 (\sy ty -> ko sy (tx<>ty))
+			 (\sy ty -> ko sy (tx<>ty)))
+instance Monoid TermIO where
+	mempty  = empty
+	mappend = (<>)
+instance IsString TermIO where
+	fromString = string
+
+writeH :: Column TermIO -> (IO.Handle -> IO ()) -> TermIO
+writeH len t =
+	TermIO $ \ro st ok ko ->
+		let newCol = st + len in
+		(if newCol <= reader_wrap_column ro then ok else ko)
+		newCol (t (reader_handle ro))
+
+instance Doc_Text TermIO where
+	empty     = TermIO $ \_ro st ok _ko -> ok st mempty
+	charH   t = writeH 1 (`IO.hPutChar` t)
+	stringH t = writeH (List.length t) (`IO.hPutStr` t)
+	textH   t = writeH (Text.length t) (`Text.hPutStr` t)
+	ltextH  t = writeH (intOfInt64 $ TL.length t) (`TL.hPutStr` t)
+	int       = stringH . show
+	integer   = stringH . show
+	replicate cnt p | cnt <= 0  = empty
+	                | otherwise = p <> replicate (pred cnt) p
+	newline = TermIO $ \ro -> unTermIO (reader_newline ro) ro
+instance Doc_Align TermIO where
+	align p = TermIO $ \ro st -> unTermIO p ro{reader_indent=st} st
+	withNewline nl  p = TermIO $ \ro -> unTermIO p ro{reader_newline=nl}
+	withIndent  ind p = TermIO $ \ro -> unTermIO p ro{reader_indent=ind}
+	incrIndent  ind p = TermIO $ \ro -> unTermIO p ro{reader_indent=reader_indent ro + ind}
+	column f = TermIO $ \ro st -> unTermIO (f st) ro st
+	newlineWithoutIndent = TermIO $ \ro _st ok _ko ->
+		ok 0 $ IO.hPutChar (reader_handle ro) '\n'
+	newlineWithIndent = TermIO $ \ro@Reader{reader_handle=h} _st ok _ko ->
+		ok (reader_indent ro) $ do
+			IO.hPutChar h '\n'
+			IO.hPutStr h $ List.replicate (reader_indent ro) ' '
+instance Doc_Wrap TermIO where
+	ifFit x y = TermIO $ \ro st ok ko ->
+		unTermIO x ro st ok (\_sx _tx -> unTermIO y ro st ok ko)
+	breakpoint onNoBreak onBreak p = TermIO $ \ro st ok ko ->
+		unTermIO (onNoBreak <> p) ro st ok
+		 (\_sp _tp -> unTermIO (onBreak <> p) ro st ok ko)
+	withWrapColumn col p = TermIO $ \ro -> unTermIO p ro{reader_wrap_column=col}
+
+writeSGR :: SGR -> TermIO -> TermIO
+writeSGR s p = o <> m <> c
+	where
+	o = TermIO $ \ro st ok _ko -> ok st $ hSetSGR (reader_handle ro) [s]
+	m = TermIO $ \ro -> unTermIO p ro{reader_sgr=s:reader_sgr ro}
+	c = TermIO $ \ro st ok _ko -> ok st $ hSetSGR (reader_handle ro) $ Reset:List.reverse (reader_sgr ro)
+
+instance Doc_Color TermIO where
+	reverse     = writeSGR $ SetSwapForegroundBackground True
+	black       = writeSGR $ SetColor Foreground Dull  Black
+	red         = writeSGR $ SetColor Foreground Dull  Red
+	green       = writeSGR $ SetColor Foreground Dull  Green
+	yellow      = writeSGR $ SetColor Foreground Dull  Yellow
+	blue        = writeSGR $ SetColor Foreground Dull  Blue
+	magenta     = writeSGR $ SetColor Foreground Dull  Magenta
+	cyan        = writeSGR $ SetColor Foreground Dull  Cyan
+	white       = writeSGR $ SetColor Foreground Dull  White
+	blacker     = writeSGR $ SetColor Foreground Vivid Black
+	redder      = writeSGR $ SetColor Foreground Vivid Red
+	greener     = writeSGR $ SetColor Foreground Vivid Green
+	yellower    = writeSGR $ SetColor Foreground Vivid Yellow
+	bluer       = writeSGR $ SetColor Foreground Vivid Blue
+	magentaer   = writeSGR $ SetColor Foreground Vivid Magenta
+	cyaner      = writeSGR $ SetColor Foreground Vivid Cyan
+	whiter      = writeSGR $ SetColor Foreground Vivid White
+	onBlack     = writeSGR $ SetColor Background Dull  Black
+	onRed       = writeSGR $ SetColor Background Dull  Red
+	onGreen     = writeSGR $ SetColor Background Dull  Green
+	onYellow    = writeSGR $ SetColor Background Dull  Yellow
+	onBlue      = writeSGR $ SetColor Background Dull  Blue
+	onMagenta   = writeSGR $ SetColor Background Dull  Magenta
+	onCyan      = writeSGR $ SetColor Background Dull  Cyan
+	onWhite     = writeSGR $ SetColor Background Dull  White
+	onBlacker   = writeSGR $ SetColor Background Vivid Black
+	onRedder    = writeSGR $ SetColor Background Vivid Red
+	onGreener   = writeSGR $ SetColor Background Vivid Green
+	onYellower  = writeSGR $ SetColor Background Vivid Yellow
+	onBluer     = writeSGR $ SetColor Background Vivid Blue
+	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
+	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
+	onWhiter    = writeSGR $ SetColor Background Vivid White
+instance Doc_Decoration TermIO where
+	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
+	underline   = writeSGR $ SetUnderlining SingleUnderline
+	italic      = writeSGR $ SetItalicized True
diff --git a/symantic-document/Language/Symantic/Document/Valid.hs b/symantic-document/Language/Symantic/Document/Valid.hs
deleted file mode 100644
index bb4209c..0000000
--- a/symantic-document/Language/Symantic/Document/Valid.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-module Language.Symantic.Document.Valid where
-
-import Control.Applicative (Applicative(..))
-import Control.Monad (Monad(..))
-import Data.Eq (Eq(..))
-import Data.Foldable (elem)
-import Data.Function (($), (.), id)
-import Data.Functor (Functor(..))
-import Data.Int (Int)
-import Data.Monoid (Monoid(..))
-import Data.Ord (Ord(..))
-import Data.Semigroup (Semigroup(..))
-import Data.String (IsString(..))
-import Text.Show (Show)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-
-import Language.Symantic.Document.Sym
-
--- * Type 'Valid'
-data Valid repr
- =   KO [Error_Valid]
- |   Ok repr
- deriving (Eq, Show)
-instance IsString repr => IsString (Valid repr) where
-	fromString = Ok . fromString
-
-valid :: Valid repr -> Valid repr
-valid = id
-
--- ** Type 'Error_Valid'
-data Error_Valid
- =   Error_Valid_not_horizontal TL.Text
- |   Error_Valid_negative_replicate Int
- deriving (Eq, Show)
-
-instance Semigroup repr => Semigroup (Valid repr) where
-	Ok x <> Ok y = Ok $ x <> y
-	KO x <> Ok _ = KO x
-	Ok _ <> KO y = KO y
-	KO x <> KO y = KO $ x <> y
-instance (Doc_Text repr, Semigroup repr) => Monoid (Valid repr) where
-	mempty  = empty
-	mappend = (<>)
-instance Functor Valid where
-	fmap _ (KO e) = KO e
-	fmap f (Ok a) = Ok $ f a
-instance Applicative Valid where
-	pure = Ok
-	Ok f  <*> Ok a  = Ok $ f a
-	KO e  <*> KO e' = KO $ e <> e'
-	Ok _f <*> KO e  = KO e
-	KO e  <*> Ok _a = KO e
-instance Monad Valid where
-	return = Ok
-	Ok a >>= f = f a
-	KO e >>= _ = KO e
-instance (Doc_Text repr, Semigroup repr) => Doc_Text (Valid repr) where
-	replicate i _ | i < 0 = KO [Error_Valid_negative_replicate i]
-	replicate i d         = d >>= Ok . replicate i
-	empty     = pure empty
-	int       = pure . int
-	integer   = pure . integer
-	char      = pure . char
-	string    = pure . string
-	text      = pure . text
-	ltext     = pure . ltext
-	charH '\n'= KO [Error_Valid_not_horizontal $ TL.singleton '\n']
-	charH c   = Ok $ charH c
-	stringH t | '\n' `elem` t = KO [Error_Valid_not_horizontal $ fromString t]
-	stringH t = Ok $ stringH t
-	textH   t | T.any (== '\n') t = KO [Error_Valid_not_horizontal $ TL.fromStrict t]
-	textH   t = Ok $ textH t
-	ltextH  t | TL.any (== '\n') t = KO [Error_Valid_not_horizontal t]
-	ltextH  t = Ok $ ltextH t
-instance Doc_Color repr => Doc_Color (Valid repr) where
-	reverse     = fmap reverse
-	black       = fmap black
-	red         = fmap red
-	green       = fmap green
-	yellow      = fmap yellow
-	blue        = fmap blue
-	magenta     = fmap magenta
-	cyan        = fmap cyan
-	white       = fmap white
-	blacker     = fmap blacker
-	redder      = fmap redder
-	greener     = fmap greener
-	yellower    = fmap yellower
-	bluer       = fmap bluer
-	magentaer   = fmap magentaer
-	cyaner      = fmap cyaner
-	whiter      = fmap whiter
-	onBlack     = fmap onBlack
-	onRed       = fmap onRed
-	onGreen     = fmap onGreen
-	onYellow    = fmap onYellow
-	onBlue      = fmap onBlue
-	onMagenta   = fmap onMagenta
-	onCyan      = fmap onCyan
-	onWhite     = fmap onWhite
-	onBlacker   = fmap onBlacker
-	onRedder    = fmap onRedder
-	onGreener   = fmap onGreener
-	onYellower  = fmap onYellower
-	onBluer     = fmap onBluer
-	onMagentaer = fmap onMagentaer
-	onCyaner    = fmap onCyaner
-	onWhiter    = fmap onWhiter
-instance Doc_Decoration repr => Doc_Decoration (Valid repr) where
-	bold      = fmap bold
-	italic    = fmap italic
-	underline = fmap underline
diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index 8c8f15d..b8282ee 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -2,7 +2,7 @@ name: symantic-document
 -- PVP:  +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 0.0.0.20180213
+version: 0.1.0.20180213
 category: Text
 synopsis: Document symantics.
 description: Symantics for generating documents.
@@ -29,10 +29,10 @@ source-repository head
 Library
   exposed-modules:
     Language.Symantic.Document
-    Language.Symantic.Document.Dim
-    Language.Symantic.Document.Plain
     Language.Symantic.Document.Sym
-    Language.Symantic.Document.Valid
+    Language.Symantic.Document.Term
+    Language.Symantic.Document.Term.Dim
+    Language.Symantic.Document.Term.IO
   default-language: Haskell2010
   default-extensions:
     DataKinds
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 606bd29..2f3b65e 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -5,34 +5,31 @@ module HUnit where
 import Test.Tasty
 import Test.Tasty.HUnit
 
--- import Data.Monoid (Monoid(..))
--- import qualified Control.Monad.Trans.State as S
-import qualified Data.List as List
-import Text.Show (Show(..))
-import Data.Functor ((<$>))
--- import qualified Data.Text.Lazy.Builder as TLB
-import Prelude (Num)
 import Data.Foldable (Foldable(..))
 import Data.Function (($))
+import Data.Functor ((<$>))
 import Data.Int (Int)
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String)
+import Prelude (Num)
+import Text.Show (Show(..))
+import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
 
-import qualified Language.Symantic.Document as Doc
+import qualified Language.Symantic.Document.Term as Doc
 import Language.Symantic.Document ((<+>))
 
 -- * Tests
 hunits :: TestTree
 hunits = testGroup "HUnit" $
- [ hunitsPlain
+ [ hunitsTerm
  ]
 
 infix 0 ==>
-(==>) :: Doc.Plain -> TL.Text -> Assertion
+(==>) :: Doc.Term -> TL.Text -> Assertion
 p ==> expected = got @?= expected
-	where got = Doc.textPlain p
+	where got = Doc.textTerm p
 
 testList :: String -> [Assertion] -> TestTree
 testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
@@ -47,8 +44,8 @@ testMessage msg =
 	 '\n' -> "\\n"
 	 c -> [c]
 
-hunitsPlain :: TestTree
-hunitsPlain = testGroup "Plain"
+hunitsTerm :: TestTree
+hunitsTerm = testGroup "Term"
  [ testList "Doc_Text"
    [ Doc.newline ==> "\n"
    , Doc.stringH "hello" ==> "hello"
-- 
2.44.1


From 97cbc459c1533c48908237bdfa8d01876f99c2a2 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Thu, 8 Mar 2018 01:19:27 +0100
Subject: [PATCH 12/16] Add colorable and decorable.

---
 .../Language/Symantic/Document/Sym.hs         | 11 ++++++
 .../Language/Symantic/Document/Term.hs        | 38 ++++++++++++-------
 .../Language/Symantic/Document/Term/Dim.hs    |  8 ++++
 .../Language/Symantic/Document/Term/IO.hs     |  8 ++++
 symantic-document/symantic-document.cabal     |  1 -
 symantic-document/test/HUnit.hs               |  2 +-
 6 files changed, 53 insertions(+), 15 deletions(-)

diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 22e8c9e..11a3faa 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -1,5 +1,6 @@
 module Language.Symantic.Document.Sym where
 
+import Data.Bool
 import Data.Char (Char)
 import Data.Eq (Eq(..))
 import Data.Foldable (Foldable(..))
@@ -192,6 +193,11 @@ class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
 
 -- * Class 'Doc_Color'
 class Doc_Color d where
+	-- | @('colorable' f)@ returns @f@ applied to whether colors are activated or not.
+	colorable :: (Bool -> d) -> d
+	-- | @('withColor' b d)@ whether to active colors or not within @d@.
+	withColorable :: Bool -> d -> d
+	
 	reverse :: d -> d
 	
 	-- Foreground colors
@@ -306,6 +312,11 @@ class Doc_Color d where
 
 -- * Class 'Doc_Decoration'
 class Doc_Decoration d where
+	-- | @('decorable' f)@ returns @f@ applied to whether decorations are activated or not.
+	decorable :: (Bool -> d) -> d
+	-- | @('withColor' b d)@ whether to active decorations or not within @d@.
+	withDecorable :: Bool -> d -> d
+	
 	bold      :: d -> d
 	underline :: d -> d
 	italic    :: d -> d
diff --git a/symantic-document/Language/Symantic/Document/Term.hs b/symantic-document/Language/Symantic/Document/Term.hs
index 362f5e3..ee364f1 100644
--- a/symantic-document/Language/Symantic/Document/Term.hs
+++ b/symantic-document/Language/Symantic/Document/Term.hs
@@ -29,6 +29,8 @@ data Reader
  ,   reader_newline     :: Term           -- ^ How to display 'newline'.
  ,   reader_wrap_column :: !(Column Term) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
  ,   reader_sgr         :: ![SGR]         -- ^ Active ANSI codes.
+ ,   reader_colorable   :: !Bool          -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool          -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -38,6 +40,8 @@ defReader = Reader
  , reader_newline     = newlineWithIndent
  , reader_wrap_column = 80
  , reader_sgr         = []
+ , reader_colorable   = True
+ , reader_decorable   = True
  }
 
 -- * Type 'State'
@@ -65,7 +69,7 @@ textTerm = TLB.toLazyText . buildTerm
 
 -- | Render a 'Term' into a 'TLB.Builder'.
 buildTerm :: Term -> TLB.Builder
-buildTerm (Term p) = p defReader defState oko oko
+buildTerm (Term t) = t defReader defState oko oko
 	where oko _st = id
 
 instance IsList Term where
@@ -102,14 +106,14 @@ instance Doc_Text Term where
 	ltextH  t = writeH (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
 	int       = stringH . show
 	integer   = stringH . show
-	replicate cnt p | cnt <= 0  = empty
-	                | otherwise = p <> replicate (pred cnt) p
+	replicate cnt t | cnt <= 0  = empty
+	                | otherwise = t <> replicate (pred cnt) t
 	newline = Term $ \ro -> unTerm (reader_newline ro) ro
 instance Doc_Align Term where
-	align p = Term $ \ro st -> unTerm p ro{reader_indent=st} st
-	withNewline nl  p = Term $ \ro -> unTerm p ro{reader_newline=nl}
-	withIndent  ind p = Term $ \ro -> unTerm p ro{reader_indent=ind}
-	incrIndent  ind p = Term $ \ro -> unTerm p ro{reader_indent=reader_indent ro + ind}
+	align t = Term $ \ro st -> unTerm t ro{reader_indent=st} st
+	withNewline nl  t = Term $ \ro -> unTerm t ro{reader_newline=nl}
+	withIndent  ind t = Term $ \ro -> unTerm t ro{reader_indent=ind}
+	incrIndent  ind t = Term $ \ro -> unTerm t ro{reader_indent=reader_indent ro + ind}
 	column f = Term $ \ro st -> unTerm (f st) ro st
 	newlineWithoutIndent = Term $ \_ro _st ok _ko ->
 		ok 0 $ TLB.singleton '\n'
@@ -120,19 +124,25 @@ instance Doc_Align Term where
 instance Doc_Wrap Term where
 	ifFit x y = Term $ \ro st ok ko ->
 		unTerm x ro st ok (\_sx _tx -> unTerm y ro st ok ko)
-	breakpoint onNoBreak onBreak p = Term $ \ro st ok ko ->
-		unTerm (onNoBreak <> p) ro st ok
-		 (\_sp _tp -> unTerm (onBreak <> p) ro st ok ko)
-	withWrapColumn col p = Term $ \ro -> unTerm p ro{reader_wrap_column=col}
+	breakpoint onNoBreak onBreak t = Term $ \ro st ok ko ->
+		unTerm (onNoBreak <> t) ro st ok
+		 (\_sp _tp -> unTerm (onBreak <> t) ro st ok ko)
+	withWrapColumn col t = Term $ \ro -> unTerm t ro{reader_wrap_column=col}
 
 writeSGR :: SGR -> Term -> Term
-writeSGR s p = o <> m <> c
+writeSGR s (Term t) =
+	Term $ \ro ->
+		if reader_colorable ro
+		then unTerm (o <> m <> c) ro
+		else t ro
 	where
 	o = Term $ \_ro st ok _ko -> ok st $ fromString $ setSGRCode [s]
-	m = Term $ \ro -> unTerm p ro{reader_sgr=s:reader_sgr ro}
+	m = Term $ \ro -> t ro{reader_sgr=s:reader_sgr ro}
 	c = Term $ \ro st ok _ko -> ok st $ fromString $ setSGRCode $ Reset:List.reverse (reader_sgr ro)
 
 instance Doc_Color Term where
+	colorable f       = Term $ \ro -> unTerm (f (reader_colorable ro)) ro
+	withColorable b t = Term $ \ro -> unTerm t ro{reader_colorable=b}
 	reverse     = writeSGR $ SetSwapForegroundBackground True
 	black       = writeSGR $ SetColor Foreground Dull  Black
 	red         = writeSGR $ SetColor Foreground Dull  Red
@@ -167,6 +177,8 @@ instance Doc_Color Term where
 	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
 	onWhiter    = writeSGR $ SetColor Background Vivid White
 instance Doc_Decoration Term where
+	decorable f       = Term $ \ro -> unTerm (f (reader_decorable ro)) ro
+	withDecorable b t = Term $ \ro -> unTerm t ro{reader_decorable=b}
 	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
 	underline   = writeSGR $ SetUnderlining SingleUnderline
 	italic      = writeSGR $ SetItalicized True
diff --git a/symantic-document/Language/Symantic/Document/Term/Dim.hs b/symantic-document/Language/Symantic/Document/Term/Dim.hs
index 54734b7..7bf721b 100644
--- a/symantic-document/Language/Symantic/Document/Term/Dim.hs
+++ b/symantic-document/Language/Symantic/Document/Term/Dim.hs
@@ -48,6 +48,8 @@ data Reader
  {   reader_indent      :: !(Indent Dimension) -- ^ Current indentation level, used by 'newline'.
  ,   reader_newline     :: Dimension           -- ^ How to display 'newline'.
  ,   reader_wrap_column :: !(Column Dimension) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_colorable   :: !Bool               -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool               -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -56,6 +58,8 @@ defReader = Reader
  { reader_indent      = 0
  , reader_newline     = newlineWithIndent
  , reader_wrap_column = 80
+ , reader_colorable   = True
+ , reader_decorable   = True
  }
 
 -- * Type 'State'
@@ -151,6 +155,8 @@ instance Doc_Wrap Dimension where
 		 (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
 	withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
 instance Doc_Color Dimension where
+	colorable f       = Dimension $ \ro -> unDimension (f (reader_colorable ro)) ro
+	withColorable b t = Dimension $ \ro -> unDimension t ro{reader_colorable=b}
 	reverse     = id
 	black       = id
 	red         = id
@@ -185,6 +191,8 @@ instance Doc_Color Dimension where
 	onCyaner    = id
 	onWhiter    = id
 instance Doc_Decoration Dimension where
+	decorable f       = Dimension $ \ro -> unDimension (f (reader_decorable ro)) ro
+	withDecorable b t = Dimension $ \ro -> unDimension t ro{reader_decorable=b}
 	bold      = id
 	underline = id
 	italic    = id
diff --git a/symantic-document/Language/Symantic/Document/Term/IO.hs b/symantic-document/Language/Symantic/Document/Term/IO.hs
index f6efab7..afad5ca 100644
--- a/symantic-document/Language/Symantic/Document/Term/IO.hs
+++ b/symantic-document/Language/Symantic/Document/Term/IO.hs
@@ -33,6 +33,8 @@ data Reader
  ,   reader_wrap_column :: !(Column TermIO) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
  ,   reader_sgr         :: ![SGR]           -- ^ Active ANSI codes.
  ,   reader_handle      :: !IO.Handle       -- ^ Where to write.
+ ,   reader_colorable   :: !Bool            -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool            -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -43,6 +45,8 @@ defReader = Reader
  , reader_wrap_column = 80
  , reader_sgr         = []
  , reader_handle      = IO.stdout
+ , reader_colorable   = True
+ , reader_decorable   = True
  }
 
 -- * Type 'State'
@@ -133,6 +137,8 @@ writeSGR s p = o <> m <> c
 	c = TermIO $ \ro st ok _ko -> ok st $ hSetSGR (reader_handle ro) $ Reset:List.reverse (reader_sgr ro)
 
 instance Doc_Color TermIO where
+	colorable f       = TermIO $ \ro -> unTermIO (f (reader_colorable ro)) ro
+	withColorable b t = TermIO $ \ro -> unTermIO t ro{reader_colorable=b}
 	reverse     = writeSGR $ SetSwapForegroundBackground True
 	black       = writeSGR $ SetColor Foreground Dull  Black
 	red         = writeSGR $ SetColor Foreground Dull  Red
@@ -167,6 +173,8 @@ instance Doc_Color TermIO where
 	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
 	onWhiter    = writeSGR $ SetColor Background Vivid White
 instance Doc_Decoration TermIO where
+	decorable f       = TermIO $ \ro -> unTermIO (f (reader_decorable ro)) ro
+	withDecorable b t = TermIO $ \ro -> unTermIO t ro{reader_decorable=b}
 	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
 	underline   = writeSGR $ SetUnderlining SingleUnderline
 	italic      = writeSGR $ SetItalicized True
diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index b8282ee..9bf2c64 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -28,7 +28,6 @@ source-repository head
 
 Library
   exposed-modules:
-    Language.Symantic.Document
     Language.Symantic.Document.Sym
     Language.Symantic.Document.Term
     Language.Symantic.Document.Term.Dim
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 2f3b65e..0a34994 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -18,7 +18,7 @@ import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
 
 import qualified Language.Symantic.Document.Term as Doc
-import Language.Symantic.Document ((<+>))
+import Language.Symantic.Document.Term ((<+>))
 
 -- * Tests
 hunits :: TestTree
-- 
2.44.1


From 27b83cd64f0bb32cab5be1873d92642f6ea2ee31 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Thu, 8 Mar 2018 02:14:50 +0100
Subject: [PATCH 13/16] Rename things such that symantic-document is neater
 when used with import qualified.

---
 .../Language/Symantic/Document/Sym.hs         | 142 +++++++++---------
 .../Language/Symantic/Document/Term.hs        |  12 +-
 .../Language/Symantic/Document/Term/Dim.hs    |  12 +-
 .../Language/Symantic/Document/Term/IO.hs     |  12 +-
 symantic-document/test/HUnit.hs               |  22 +--
 5 files changed, 100 insertions(+), 100 deletions(-)

diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 11a3faa..022b3b7 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -10,7 +10,6 @@ import Data.Int (Int, Int64)
 import Data.Ord (Ord(..), Ordering(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String, IsString)
-import Data.Text (Text)
 import Prelude (Integer, toInteger, fromIntegral, Num(..))
 import qualified Data.List as List
 import qualified Data.Text as Text
@@ -22,24 +21,24 @@ type family Column (d:: *) :: *
 -- * Type family 'Indent'
 type family Indent (d:: *) :: *
 
--- * Class 'Doc_Text'
-class (IsString d, Semigroup d) => Doc_Text d where
+-- * Class 'Textable'
+class (IsString d, Semigroup d) => Textable d where
 	charH     :: Char -- ^ XXX: MUST NOT be '\n'
 	          -> d
 	stringH   :: String -- ^ XXX: MUST NOT contain '\n'
 	          -> d
-	textH     :: Text -- ^ XXX: MUST NOT contain '\n'
+	textH     :: Text.Text -- ^ XXX: MUST NOT contain '\n'
 	          -> d
 	ltextH    :: TL.Text -- ^ XXX: MUST NOT contain '\n'
 	          -> d
 	replicate :: Int -> d -> d
 	integer   :: Integer -> d
-	default replicate :: Doc_Text (ReprOf d) => Trans d => Int -> d -> d
-	default integer   :: Doc_Text (ReprOf d) => Trans d => Integer -> d
-	default charH     :: Doc_Text (ReprOf d) => Trans d => Char -> d
-	default stringH   :: Doc_Text (ReprOf d) => Trans d => String -> d
-	default textH     :: Doc_Text (ReprOf d) => Trans d => Text -> d
-	default ltextH    :: Doc_Text (ReprOf d) => Trans d => TL.Text -> d
+	default replicate :: Textable (ReprOf d) => Trans d => Int -> d -> d
+	default integer   :: Textable (ReprOf d) => Trans d => Integer -> d
+	default charH     :: Textable (ReprOf d) => Trans d => Char -> d
+	default stringH   :: Textable (ReprOf d) => Trans d => String -> d
+	default textH     :: Textable (ReprOf d) => Trans d => Text.Text -> d
+	default ltextH    :: Textable (ReprOf d) => Trans d => TL.Text -> d
 	charH     = trans . charH
 	stringH   = trans . stringH
 	textH     = trans . textH
@@ -57,7 +56,7 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	int         :: Int -> d
 	char        :: Char    -> d
 	string      :: String  -> d
-	text        :: Text    -> d
+	text        :: Text.Text  -> d
 	ltext       :: TL.Text -> d
 	catH        :: Foldable f => f d -> d
 	catV        :: Foldable f => f d -> d
@@ -81,13 +80,13 @@ class (IsString d, Semigroup d) => Doc_Text d where
 	foldWith  f     = foldrWith $ \a acc -> a <> f acc
 	intercalate sep = foldrWith (\x y -> x<>sep<>y)
 	between o c d = o<>d<>c
-	-- default catH :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
-	-- default catV :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
+	-- default catH :: Textable (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
+	-- default catV :: Textable (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
 	-- catH  l = trans (catH (fmap unTrans l))
 	-- catV  l = trans (catV (fmap unTrans l))
 
--- * Class 'Doc_Align'
-class Doc_Text d => Doc_Align d where
+-- * Class 'Alignable'
+class Textable d => Alignable d where
 	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
 	align :: d -> d
 	-- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
@@ -103,9 +102,9 @@ class Doc_Text d => Doc_Align d where
 	withNewline :: d -> d -> d
 	newlineWithoutIndent :: d
 	newlineWithIndent    :: d
-	-- | @('column' f)@ returns @f@ applied to the current 'Column'.
+	-- | @('column' f)@ return @f@ applied to the current 'Column'.
 	column :: (Column d -> d) -> d
-	-- | @('endToEndWidth' d f)@ returns @d@ concatenated to
+	-- | @('endToEndWidth' d f)@ return @d@ concatenated to
 	-- @f@ applied to the difference between the end 'Column' and start 'Column' of @d@.
 	--
 	-- Note that @f@ is given the end-to-end width,
@@ -122,7 +121,7 @@ class Doc_Text d => Doc_Align d where
 	spaces :: Indent d -> d
 	spaces i = replicate i space
 	
-	-- | @('fill' ind d)@ returns @d@ then as many 'space's as needed
+	-- | @('fill' ind d)@ return @d@ then as many 'space's as needed
 	-- so that the whole is @ind@ 'Column's wide.
 	default fill ::
 	 Indent d ~ Int =>
@@ -135,7 +134,7 @@ class Doc_Text d => Doc_Align d where
 			 LT -> spaces $ m - w
 			 _  -> empty
 	
-	-- | @('breakableFill' ind f d)@ returns @f@ then as many 'space's as needed
+	-- | @('breakableFill' ind f d)@ return @f@ then as many 'space's as needed
 	-- so that the whole is @ind@ 'Column's wide,
 	-- then, if @f@ is not wider than @ind@, appends @d@,
 	-- otherwise appends a 'newline' and @d@,
@@ -153,24 +152,24 @@ class Doc_Text d => Doc_Align d where
 			 EQ -> d
 			 GT -> withIndent (c + m) (newline <> d)
 
--- * Class 'Doc_Wrap'
-class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
-	-- | @('ifFit' onFit onNoFit)@
-	-- return @onFit@ if @onFit@ leads to a 'Column'
-	-- lower or equal to the one sets with 'withWrapColumn',
-	-- otherwise return @onNoFit@.
-	ifFit :: d -> d -> d
+-- * Class 'Wrapable'
+class (Textable d, Alignable d) => Wrapable d where
+	-- | @('ifWrap' onWrap onNoWrap)@
+	-- return @onWrap@ if @onNoWrap@ leads to a 'Column'
+	-- greater or equal to the one sets with 'withWrapColumn',
+	-- otherwise return @onNoWrap@.
+	ifWrap :: d -> d -> d
 	-- | @('breakpoint' onNoBreak onBreak d)@
 	-- return @onNoBreak@ then @d@ if they fit,
 	-- @onBreak@ otherwise.
 	breakpoint :: d -> d -> d -> d
-	-- | @('breakableEmpty' d)@ returns @d@ if it fits, 'newline' then @d@ otherwise.
+	-- | @('breakableEmpty' d)@ return @d@ if it fits, 'newline' then @d@ otherwise.
 	breakableEmpty :: d -> d
 	breakableEmpty = breakpoint empty newline
 	-- | @x '><' y = x '<>' 'breakableEmpty' y@
 	(><) :: d -> d -> d
 	x >< y = x <> breakableEmpty y
-	-- | @('breakableSpace' d)@ returns 'space' then @d@ it they fit,
+	-- | @('breakableSpace' d)@ return 'space' then @d@ it they fit,
 	-- 'newline' then @d@ otherwise.
 	breakableSpace :: d -> d
 	breakableSpace = breakpoint space newline
@@ -188,12 +187,13 @@ class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
 	-- otherwise return 'align' of @ds@ with 'newline' and @sep@ intercalated.
 	intercalateHorV :: Foldable f => d -> f d -> d
 	intercalateHorV sep xs =
-		ifFit (foldWith (sep <>) xs)
+		ifWrap
 		 (align $ foldWith ((newline <> sep) <>) xs)
+		 (foldWith (sep <>) xs)
 
--- * Class 'Doc_Color'
-class Doc_Color d where
-	-- | @('colorable' f)@ returns @f@ applied to whether colors are activated or not.
+-- * Class 'Colorable'
+class Colorable d where
+	-- | @('colorable' f)@ return @f@ applied to whether colors are activated or not.
 	colorable :: (Bool -> d) -> d
 	-- | @('withColor' b d)@ whether to active colors or not within @d@.
 	withColorable :: Bool -> d -> d
@@ -242,39 +242,39 @@ class Doc_Color d where
 	onCyaner    :: d -> d
 	onWhiter    :: d -> d
 	
-	default reverse     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default black       :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default red         :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default green       :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default yellow      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default blue        :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default magenta     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default cyan        :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default white       :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default blacker     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default redder      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default greener     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default yellower    :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default bluer       :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default magentaer   :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default cyaner      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default whiter      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onBlack     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onRed       :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onGreen     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onYellow    :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onBlue      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onMagenta   :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onCyan      :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onWhite     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onBlacker   :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onRedder    :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onGreener   :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onYellower  :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onBluer     :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onMagentaer :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onCyaner    :: Doc_Color (ReprOf d) => Trans d => d -> d
-	default onWhiter    :: Doc_Color (ReprOf d) => Trans d => d -> d
+	default reverse     :: Colorable (ReprOf d) => Trans d => d -> d
+	default black       :: Colorable (ReprOf d) => Trans d => d -> d
+	default red         :: Colorable (ReprOf d) => Trans d => d -> d
+	default green       :: Colorable (ReprOf d) => Trans d => d -> d
+	default yellow      :: Colorable (ReprOf d) => Trans d => d -> d
+	default blue        :: Colorable (ReprOf d) => Trans d => d -> d
+	default magenta     :: Colorable (ReprOf d) => Trans d => d -> d
+	default cyan        :: Colorable (ReprOf d) => Trans d => d -> d
+	default white       :: Colorable (ReprOf d) => Trans d => d -> d
+	default blacker     :: Colorable (ReprOf d) => Trans d => d -> d
+	default redder      :: Colorable (ReprOf d) => Trans d => d -> d
+	default greener     :: Colorable (ReprOf d) => Trans d => d -> d
+	default yellower    :: Colorable (ReprOf d) => Trans d => d -> d
+	default bluer       :: Colorable (ReprOf d) => Trans d => d -> d
+	default magentaer   :: Colorable (ReprOf d) => Trans d => d -> d
+	default cyaner      :: Colorable (ReprOf d) => Trans d => d -> d
+	default whiter      :: Colorable (ReprOf d) => Trans d => d -> d
+	default onBlack     :: Colorable (ReprOf d) => Trans d => d -> d
+	default onRed       :: Colorable (ReprOf d) => Trans d => d -> d
+	default onGreen     :: Colorable (ReprOf d) => Trans d => d -> d
+	default onYellow    :: Colorable (ReprOf d) => Trans d => d -> d
+	default onBlue      :: Colorable (ReprOf d) => Trans d => d -> d
+	default onMagenta   :: Colorable (ReprOf d) => Trans d => d -> d
+	default onCyan      :: Colorable (ReprOf d) => Trans d => d -> d
+	default onWhite     :: Colorable (ReprOf d) => Trans d => d -> d
+	default onBlacker   :: Colorable (ReprOf d) => Trans d => d -> d
+	default onRedder    :: Colorable (ReprOf d) => Trans d => d -> d
+	default onGreener   :: Colorable (ReprOf d) => Trans d => d -> d
+	default onYellower  :: Colorable (ReprOf d) => Trans d => d -> d
+	default onBluer     :: Colorable (ReprOf d) => Trans d => d -> d
+	default onMagentaer :: Colorable (ReprOf d) => Trans d => d -> d
+	default onCyaner    :: Colorable (ReprOf d) => Trans d => d -> d
+	default onWhiter    :: Colorable (ReprOf d) => Trans d => d -> d
 	
 	reverse     = trans1 reverse
 	black       = trans1 black
@@ -310,9 +310,9 @@ class Doc_Color d where
 	onCyaner    = trans1 onCyaner
 	onWhiter    = trans1 onWhiter
 
--- * Class 'Doc_Decoration'
-class Doc_Decoration d where
-	-- | @('decorable' f)@ returns @f@ applied to whether decorations are activated or not.
+-- * Class 'Decorable'
+class Decorable d where
+	-- | @('decorable' f)@ return @f@ applied to whether decorations are activated or not.
 	decorable :: (Bool -> d) -> d
 	-- | @('withColor' b d)@ whether to active decorations or not within @d@.
 	withDecorable :: Bool -> d -> d
@@ -320,9 +320,9 @@ class Doc_Decoration d where
 	bold      :: d -> d
 	underline :: d -> d
 	italic    :: d -> d
-	default bold      :: Doc_Decoration (ReprOf d) => Trans d => d -> d
-	default underline :: Doc_Decoration (ReprOf d) => Trans d => d -> d
-	default italic    :: Doc_Decoration (ReprOf d) => Trans d => d -> d
+	default bold      :: Decorable (ReprOf d) => Trans d => d -> d
+	default underline :: Decorable (ReprOf d) => Trans d => d -> d
+	default italic    :: Decorable (ReprOf d) => Trans d => d -> d
 	bold      = trans1 bold
 	underline = trans1 underline
 	italic    = trans1 italic
diff --git a/symantic-document/Language/Symantic/Document/Term.hs b/symantic-document/Language/Symantic/Document/Term.hs
index ee364f1..055944b 100644
--- a/symantic-document/Language/Symantic/Document/Term.hs
+++ b/symantic-document/Language/Symantic/Document/Term.hs
@@ -98,7 +98,7 @@ writeH len t =
 		(if newCol <= reader_wrap_column ro then ok else ko)
 		newCol t
 
-instance Doc_Text Term where
+instance Textable Term where
 	empty     = Term $ \_ro st ok _ko -> ok st mempty
 	charH   t = writeH 1 $ TLB.singleton t
 	stringH t = writeH (List.length t) (fromString t)
@@ -109,7 +109,7 @@ instance Doc_Text Term where
 	replicate cnt t | cnt <= 0  = empty
 	                | otherwise = t <> replicate (pred cnt) t
 	newline = Term $ \ro -> unTerm (reader_newline ro) ro
-instance Doc_Align Term where
+instance Alignable Term where
 	align t = Term $ \ro st -> unTerm t ro{reader_indent=st} st
 	withNewline nl  t = Term $ \ro -> unTerm t ro{reader_newline=nl}
 	withIndent  ind t = Term $ \ro -> unTerm t ro{reader_indent=ind}
@@ -121,8 +121,8 @@ instance Doc_Align Term where
 		ok (reader_indent ro) $
 			TLB.singleton '\n' <>
 			fromString (List.replicate (reader_indent ro) ' ')
-instance Doc_Wrap Term where
-	ifFit x y = Term $ \ro st ok ko ->
+instance Wrapable Term where
+	ifWrap y x = Term $ \ro st ok ko ->
 		unTerm x ro st ok (\_sx _tx -> unTerm y ro st ok ko)
 	breakpoint onNoBreak onBreak t = Term $ \ro st ok ko ->
 		unTerm (onNoBreak <> t) ro st ok
@@ -140,7 +140,7 @@ writeSGR s (Term t) =
 	m = Term $ \ro -> t ro{reader_sgr=s:reader_sgr ro}
 	c = Term $ \ro st ok _ko -> ok st $ fromString $ setSGRCode $ Reset:List.reverse (reader_sgr ro)
 
-instance Doc_Color Term where
+instance Colorable Term where
 	colorable f       = Term $ \ro -> unTerm (f (reader_colorable ro)) ro
 	withColorable b t = Term $ \ro -> unTerm t ro{reader_colorable=b}
 	reverse     = writeSGR $ SetSwapForegroundBackground True
@@ -176,7 +176,7 @@ instance Doc_Color Term where
 	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
 	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
 	onWhiter    = writeSGR $ SetColor Background Vivid White
-instance Doc_Decoration Term where
+instance Decorable Term where
 	decorable f       = Term $ \ro -> unTerm (f (reader_decorable ro)) ro
 	withDecorable b t = Term $ \ro -> unTerm t ro{reader_decorable=b}
 	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
diff --git a/symantic-document/Language/Symantic/Document/Term/Dim.hs b/symantic-document/Language/Symantic/Document/Term/Dim.hs
index 7bf721b..928eb9d 100644
--- a/symantic-document/Language/Symantic/Document/Term/Dim.hs
+++ b/symantic-document/Language/Symantic/Document/Term/Dim.hs
@@ -114,7 +114,7 @@ writeH len =
 		 , dim_width_first = newCol
 		 }
 
-instance Doc_Text Dimension where
+instance Textable Dimension where
 	empty     = Dimension $ \_ro st ok _ko -> ok st mempty
 	charH   _ = writeH 1
 	stringH t = writeH $ List.length t
@@ -125,7 +125,7 @@ instance Doc_Text Dimension where
 	replicate cnt p | cnt <= 0  = empty
 	                | otherwise = p <> replicate (pred cnt) p
 	newline = Dimension $ \ro -> unDimension (reader_newline ro) ro
-instance Doc_Align Dimension where
+instance Alignable Dimension where
 	align p = Dimension $ \ro st -> unDimension p ro{reader_indent=st} st
 	withNewline nl  p = Dimension $ \ro -> unDimension p ro{reader_newline=nl}
 	withIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=ind}
@@ -147,14 +147,14 @@ instance Doc_Align Dimension where
 		 , dim_width_last  = ind
 		 }
 
-instance Doc_Wrap Dimension where
-	ifFit x y = Dimension $ \ro st ok ko ->
+instance Wrapable Dimension where
+	ifWrap y x = Dimension $ \ro st ok ko ->
 		unDimension x ro st ok (\_sx _tx -> unDimension y ro st ok ko)
 	breakpoint onNoBreak onBreak p = Dimension $ \ro st ok ko ->
 		unDimension (onNoBreak <> p) ro st ok
 		 (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
 	withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
-instance Doc_Color Dimension where
+instance Colorable Dimension where
 	colorable f       = Dimension $ \ro -> unDimension (f (reader_colorable ro)) ro
 	withColorable b t = Dimension $ \ro -> unDimension t ro{reader_colorable=b}
 	reverse     = id
@@ -190,7 +190,7 @@ instance Doc_Color Dimension where
 	onMagentaer = id
 	onCyaner    = id
 	onWhiter    = id
-instance Doc_Decoration Dimension where
+instance Decorable Dimension where
 	decorable f       = Dimension $ \ro -> unDimension (f (reader_decorable ro)) ro
 	withDecorable b t = Dimension $ \ro -> unDimension t ro{reader_decorable=b}
 	bold      = id
diff --git a/symantic-document/Language/Symantic/Document/Term/IO.hs b/symantic-document/Language/Symantic/Document/Term/IO.hs
index afad5ca..5bbe4df 100644
--- a/symantic-document/Language/Symantic/Document/Term/IO.hs
+++ b/symantic-document/Language/Symantic/Document/Term/IO.hs
@@ -98,7 +98,7 @@ writeH len t =
 		(if newCol <= reader_wrap_column ro then ok else ko)
 		newCol (t (reader_handle ro))
 
-instance Doc_Text TermIO where
+instance Textable TermIO where
 	empty     = TermIO $ \_ro st ok _ko -> ok st mempty
 	charH   t = writeH 1 (`IO.hPutChar` t)
 	stringH t = writeH (List.length t) (`IO.hPutStr` t)
@@ -109,7 +109,7 @@ instance Doc_Text TermIO where
 	replicate cnt p | cnt <= 0  = empty
 	                | otherwise = p <> replicate (pred cnt) p
 	newline = TermIO $ \ro -> unTermIO (reader_newline ro) ro
-instance Doc_Align TermIO where
+instance Alignable TermIO where
 	align p = TermIO $ \ro st -> unTermIO p ro{reader_indent=st} st
 	withNewline nl  p = TermIO $ \ro -> unTermIO p ro{reader_newline=nl}
 	withIndent  ind p = TermIO $ \ro -> unTermIO p ro{reader_indent=ind}
@@ -121,8 +121,8 @@ instance Doc_Align TermIO where
 		ok (reader_indent ro) $ do
 			IO.hPutChar h '\n'
 			IO.hPutStr h $ List.replicate (reader_indent ro) ' '
-instance Doc_Wrap TermIO where
-	ifFit x y = TermIO $ \ro st ok ko ->
+instance Wrapable TermIO where
+	ifWrap y x = TermIO $ \ro st ok ko ->
 		unTermIO x ro st ok (\_sx _tx -> unTermIO y ro st ok ko)
 	breakpoint onNoBreak onBreak p = TermIO $ \ro st ok ko ->
 		unTermIO (onNoBreak <> p) ro st ok
@@ -136,7 +136,7 @@ writeSGR s p = o <> m <> c
 	m = TermIO $ \ro -> unTermIO p ro{reader_sgr=s:reader_sgr ro}
 	c = TermIO $ \ro st ok _ko -> ok st $ hSetSGR (reader_handle ro) $ Reset:List.reverse (reader_sgr ro)
 
-instance Doc_Color TermIO where
+instance Colorable TermIO where
 	colorable f       = TermIO $ \ro -> unTermIO (f (reader_colorable ro)) ro
 	withColorable b t = TermIO $ \ro -> unTermIO t ro{reader_colorable=b}
 	reverse     = writeSGR $ SetSwapForegroundBackground True
@@ -172,7 +172,7 @@ instance Doc_Color TermIO where
 	onMagentaer = writeSGR $ SetColor Background Vivid Magenta
 	onCyaner    = writeSGR $ SetColor Background Vivid Cyan
 	onWhiter    = writeSGR $ SetColor Background Vivid White
-instance Doc_Decoration TermIO where
+instance Decorable TermIO where
 	decorable f       = TermIO $ \ro -> unTermIO (f (reader_decorable ro)) ro
 	withDecorable b t = TermIO $ \ro -> unTermIO t ro{reader_decorable=b}
 	bold        = writeSGR $ SetConsoleIntensity BoldIntensity
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 0a34994..04cafd7 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -46,13 +46,13 @@ testMessage msg =
 
 hunitsTerm :: TestTree
 hunitsTerm = testGroup "Term"
- [ testList "Doc_Text"
+ [ testList "Textable"
    [ Doc.newline ==> "\n"
    , Doc.stringH "hello" ==> "hello"
    , "hello" ==> "hello"
    , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
    ]
- , testList "Doc_Align"
+ , testList "Alignable"
    [ "hello\nworld" ==> "hello\nworld"
    , "  "<> "hello\nworld\n!" ==> "  hello\nworld\n!"
    , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n  world\n  !"
@@ -75,7 +75,7 @@ hunitsTerm = testGroup "Term"
                `List.map` [("abcdefghi","Doc ->\nDoc")])
      ==> "let abcdefghi\n           :: Doc ->\n          Doc"
    ]
- , testList "Doc_Wrap"
+ , testList "Wrapable"
    [ 10`wc` be ["hello", "world"] ==> "helloworld"
    ,  9`wc` be ["hello", "world"] ==> "hello\nworld"
    ,  6`wc` be ["he", "ll", "o!"] ==> "hello!"
@@ -106,20 +106,20 @@ hunitsTerm = testGroup "Term"
    ]
  ]
 
-be :: Doc.Doc_Wrap d => [d] -> d
+be :: Doc.Wrapable d => [d] -> d
 be = Doc.foldWith Doc.breakableEmpty
-bs :: Doc.Doc_Wrap d => [d] -> d
+bs :: Doc.Wrapable d => [d] -> d
 bs = Doc.foldWith Doc.breakableSpace
-wc :: Doc.Doc_Wrap d => Doc.Column d -> d -> d
+wc :: Doc.Wrapable d => Doc.Column d -> d -> d
 wc = Doc.withWrapColumn
 
-fun :: (Doc.Doc_Align d, Doc.Doc_Wrap d, Num (Doc.Indent d)) => d -> d
-fun x = "function(" <> Doc.incrIndent 2 (Doc.ifFit (x) (Doc.newline<>x<>Doc.newline)) <> ")"
+fun :: (Doc.Alignable d, Doc.Wrapable d, Num (Doc.Indent d)) => d -> d
+fun x = "function(" <> Doc.incrIndent 2 (Doc.ifWrap (Doc.newline<>x<>Doc.newline) x) <> ")"
 
-listHorV :: (Doc.Doc_Align d, Doc.Doc_Wrap d) => [d] -> d
+listHorV :: (Doc.Alignable d, Doc.Wrapable d) => [d] -> d
 listHorV [] = "[]"
 listHorV [x] = "["<>x<>"]"
 listHorV xs =
-	Doc.ifFit
-	 ("[" <> Doc.intercalate ", " xs <> "]")
+	Doc.ifWrap
 	 (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
+	 ("[" <> Doc.intercalate ", " xs <> "]")
-- 
2.44.1


From fca05da6a4eea0bf8eb8badffd211f18235ad5f9 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Thu, 8 Mar 2018 03:02:49 +0100
Subject: [PATCH 14/16] Use Nat, instead of convoluted type families.

---
 .../Language/Symantic/Document/Sym.hs         | 98 ++++++++++---------
 .../Language/Symantic/Document/Term.hs        | 35 +++----
 .../Language/Symantic/Document/Term/Dim.hs    | 36 +++----
 .../Language/Symantic/Document/Term/IO.hs     | 36 +++----
 symantic-document/test/HUnit.hs               |  5 +-
 5 files changed, 101 insertions(+), 109 deletions(-)

diff --git a/symantic-document/Language/Symantic/Document/Sym.hs b/symantic-document/Language/Symantic/Document/Sym.hs
index 022b3b7..409d5e1 100644
--- a/symantic-document/Language/Symantic/Document/Sym.hs
+++ b/symantic-document/Language/Symantic/Document/Sym.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Language.Symantic.Document.Sym where
 
 import Data.Bool
@@ -6,20 +7,48 @@ import Data.Eq (Eq(..))
 import Data.Foldable (Foldable(..))
 import Data.Function ((.), ($))
 import Data.Functor (Functor(..))
-import Data.Int (Int, Int64)
+import Data.Int (Int)
 import Data.Ord (Ord(..), Ordering(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String, IsString)
-import Prelude (Integer, toInteger, fromIntegral, Num(..))
+import Prelude (Integer, toInteger, fromIntegral, Num(..), undefined, Integral, Real, Enum)
+import Text.Show (Show)
 import qualified Data.List as List
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 
--- * Type family 'Column'
-type family Column (d:: *) :: *
+-- * Type 'Nat'
+newtype Nat = Nat Integer
+ deriving (Eq, Ord, Show, Integral, Real, Enum)
+unLength :: Nat -> Integer
+unLength (Nat i) = i
+instance Num Nat where
+	fromInteger i | 0 <= i    = Nat i
+	              | otherwise = undefined
+	abs = Nat . abs . unLength
+	signum = signum . signum
+	Nat x + Nat y = Nat (x + y)
+	Nat x * Nat y = Nat (x * y)
+	Nat x - Nat y | y <= x    = Nat (x - y)
+	              | otherwise = undefined
 
--- * Type family 'Indent'
-type family Indent (d:: *) :: *
+-- ** Type 'Column'
+type Column = Nat
+
+-- ** Type 'Indent'
+type Indent = Column
+
+-- * Class 'Lengthable'
+class Lengthable a where
+	length :: a -> Nat
+instance Lengthable Char where
+	length _ = Nat 1
+instance Lengthable [a] where
+	length = Nat . fromIntegral . List.length
+instance Lengthable Text.Text where
+	length = Nat . fromIntegral . Text.length
+instance Lengthable TL.Text where
+	length = Nat . fromIntegral . TL.length
 
 -- * Class 'Textable'
 class (IsString d, Semigroup d) => Textable d where
@@ -90,12 +119,12 @@ class Textable d => Alignable d where
 	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
 	align :: d -> d
 	-- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
-	hang :: Indent d -> d -> d
+	hang :: Indent -> d -> d
 	hang ind = align . incrIndent ind
 	-- | @('incrIndent' ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
-	incrIndent  :: Indent d -> d -> d
+	incrIndent  :: Indent -> d -> d
 	-- | @('withIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.
-	withIndent  :: Indent d -> d -> d
+	withIndent  :: Indent -> d -> d
 	-- | @('withNewline' nl d)@ make @d@ uses @nl@ as 'newline'.
 	--
 	-- Useful values for @nl@ are: 'empty', 'newlineWithIndent', 'newlineWithoutIndent'.
@@ -103,35 +132,26 @@ class Textable d => Alignable d where
 	newlineWithoutIndent :: d
 	newlineWithIndent    :: d
 	-- | @('column' f)@ return @f@ applied to the current 'Column'.
-	column :: (Column d -> d) -> d
+	column :: (Column -> d) -> d
 	-- | @('endToEndWidth' d f)@ return @d@ concatenated to
 	-- @f@ applied to the difference between the end 'Column' and start 'Column' of @d@.
 	--
 	-- Note that @f@ is given the end-to-end width,
 	-- which is not necessarily the maximal width.
-	default endToEndWidth ::
-	 Semigroup d =>
-	 Num (Column d) =>
-	 d -> (Column d -> d) -> d
-	endToEndWidth :: d -> (Column d -> d) -> d
-	endToEndWidth d f = column $ \c1 -> (d <>) $ column $ \c2 -> f $ c2 - c1
+	endToEndWidth :: d -> (Column -> d) -> d
+	endToEndWidth d f = column $ \(Nat c1) -> (d <>) $ column $ \(Nat c2) -> f $ Nat $ c2 - c1
 	
 	-- | @'spaces' ind = 'replicate' ind 'space'@
-	default spaces :: Indent d ~ Int => Indent d -> d
-	spaces :: Indent d -> d
-	spaces i = replicate i space
+	spaces :: Indent -> d
+	spaces (Nat i) = replicate (fromIntegral i) space
 	
 	-- | @('fill' ind d)@ return @d@ then as many 'space's as needed
 	-- so that the whole is @ind@ 'Column's wide.
-	default fill ::
-	 Indent d ~ Int =>
-	 Column d ~ Int =>
-	 Indent d -> d -> d
-	fill :: Indent d -> d -> d
-	fill m d =
-		endToEndWidth d $ \w ->
+	fill :: Indent -> d -> d
+	fill (Nat m) d =
+		endToEndWidth d $ \(Nat w) ->
 			case w`compare`m of
-			 LT -> spaces $ m - w
+			 LT -> spaces $ Nat $ m - w
 			 _  -> empty
 	
 	-- | @('breakableFill' ind f d)@ return @f@ then as many 'space's as needed
@@ -139,18 +159,14 @@ class Textable d => Alignable d where
 	-- then, if @f@ is not wider than @ind@, appends @d@,
 	-- otherwise appends a 'newline' and @d@,
 	-- with an 'Indent' level set to the start 'Column' of @f@ plus @ind@.
-	default breakableFill ::
-	 Indent d ~ Int =>
-	 Column d ~ Int =>
-	 Indent d -> d -> d -> d
-	breakableFill :: Indent d -> d -> d -> d
-	breakableFill m f d =
-		column $ \c ->
-		endToEndWidth f $ \w ->
+	breakableFill :: Indent -> d -> d -> d
+	breakableFill (Nat m) f d =
+		column $ \(Nat c) ->
+		endToEndWidth f $ \(Nat w) ->
 			case w`compare`m of
-			 LT -> spaces (m - w) <> d
+			 LT -> spaces (Nat $ m - w) <> d
 			 EQ -> d
-			 GT -> withIndent (c + m) (newline <> d)
+			 GT -> withIndent (Nat $ c + m) (newline <> d)
 
 -- * Class 'Wrapable'
 class (Textable d, Alignable d) => Wrapable d where
@@ -181,7 +197,7 @@ class (Textable d, Alignable d) => Wrapable d where
 	breakableSpaces :: Foldable f => f d -> d
 	breakableSpaces = foldWith breakableSpace
 	-- | @'withWrapColumn' col d@ set the 'Column' triggering wrapping to @col@ within @d@.
-	withWrapColumn :: Column d -> d -> d
+	withWrapColumn :: Column -> d -> d
 	-- | @('intercalateHorV' sep ds)@
 	-- return @ds@ with @sep@ intercalated if the whole fits,
 	-- otherwise return 'align' of @ds@ with 'newline' and @sep@ intercalated.
@@ -353,12 +369,6 @@ class Trans tr where
 	 -> (tr -> tr -> tr -> tr)
 	trans3 f t1 t2 t3 = trans (f (unTrans t1) (unTrans t2) (unTrans t3))
 
-int64OfInt :: Int -> Int64
-int64OfInt = fromIntegral
-
-intOfInt64 :: Int64 -> Int
-intOfInt64 = fromIntegral
-
 -- | Break a 'String' into lines while preserving all empty lines.
 lines :: String -> [String]
 lines cs =
diff --git a/symantic-document/Language/Symantic/Document/Term.hs b/symantic-document/Language/Symantic/Document/Term.hs
index 055944b..f55d018 100644
--- a/symantic-document/Language/Symantic/Document/Term.hs
+++ b/symantic-document/Language/Symantic/Document/Term.hs
@@ -6,17 +6,15 @@ module Language.Symantic.Document.Term
 import Control.Applicative (Applicative(..))
 import Data.Bool
 import Data.Function (($), (.), id)
-import Data.Int (Int)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
 import GHC.Exts (IsList(..))
-import Prelude ((+), pred)
+import Prelude (pred, fromIntegral, Num(..))
 import System.Console.ANSI
 import Text.Show (Show(..))
 import qualified Data.List as List
-import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TLB
 
@@ -25,12 +23,12 @@ import Language.Symantic.Document.Sym
 -- * Type 'Reader'
 data Reader
  =   Reader
- {   reader_indent      :: !(Indent Term) -- ^ Current indentation level, used by 'newline'.
- ,   reader_newline     :: Term           -- ^ How to display 'newline'.
- ,   reader_wrap_column :: !(Column Term) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
- ,   reader_sgr         :: ![SGR]         -- ^ Active ANSI codes.
- ,   reader_colorable   :: !Bool          -- ^ Whether colors are activated or not.
- ,   reader_decorable   :: !Bool          -- ^ Whether decorations are activated or not.
+ {   reader_indent      :: !Indent -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: Term    -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !Column -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_sgr         :: ![SGR]  -- ^ Active ANSI codes.
+ ,   reader_colorable   :: !Bool   -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool   -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -38,14 +36,14 @@ defReader :: Reader
 defReader = Reader
  { reader_indent      = 0
  , reader_newline     = newlineWithIndent
- , reader_wrap_column = 80
+ , reader_wrap_column = Nat 80
  , reader_sgr         = []
  , reader_colorable   = True
  , reader_decorable   = True
  }
 
 -- * Type 'State'
-type State = Column Term
+type State = Column
 
 -- | Default 'State'.
 defState :: State
@@ -60,9 +58,6 @@ newtype Term
                 (State -> TLB.Builder -> TLB.Builder) -> -- should-wrap continuation
                 TLB.Builder }
 
-type instance Column Term = Int
-type instance Indent Term = Int
-
 -- | Render a 'Term' into a 'TL.Text'.
 textTerm :: Term -> TL.Text
 textTerm = TLB.toLazyText . buildTerm
@@ -91,7 +86,7 @@ instance Monoid Term where
 instance IsString Term where
 	fromString = string
 
-writeH :: Column Term -> TLB.Builder -> Term
+writeH :: Column -> TLB.Builder -> Term
 writeH len t =
 	Term $ \ro st ok ko ->
 		let newCol = st + len in
@@ -100,10 +95,10 @@ writeH len t =
 
 instance Textable Term where
 	empty     = Term $ \_ro st ok _ko -> ok st mempty
-	charH   t = writeH 1 $ TLB.singleton t
-	stringH t = writeH (List.length t) (fromString t)
-	textH   t = writeH (Text.length t) (TLB.fromText t)
-	ltextH  t = writeH (intOfInt64 $ TL.length t) (TLB.fromLazyText t)
+	charH   t = writeH (Nat 1) (TLB.singleton t)
+	stringH t = writeH (length t) (fromString t)
+	textH   t = writeH (length t) (TLB.fromText t)
+	ltextH  t = writeH (length t) (TLB.fromLazyText t)
 	int       = stringH . show
 	integer   = stringH . show
 	replicate cnt t | cnt <= 0  = empty
@@ -120,7 +115,7 @@ instance Alignable Term where
 	newlineWithIndent = Term $ \ro _st ok _ko ->
 		ok (reader_indent ro) $
 			TLB.singleton '\n' <>
-			fromString (List.replicate (reader_indent ro) ' ')
+			fromString (List.replicate (fromIntegral $ reader_indent ro) ' ')
 instance Wrapable Term where
 	ifWrap y x = Term $ \ro st ok ko ->
 		unTerm x ro st ok (\_sx _tx -> unTerm y ro st ok ko)
diff --git a/symantic-document/Language/Symantic/Document/Term/Dim.hs b/symantic-document/Language/Symantic/Document/Term/Dim.hs
index 928eb9d..1a1e653 100644
--- a/symantic-document/Language/Symantic/Document/Term/Dim.hs
+++ b/symantic-document/Language/Symantic/Document/Term/Dim.hs
@@ -7,7 +7,6 @@ import Control.Applicative (Applicative(..))
 import Data.Bool
 import Data.Eq (Eq(..))
 import Data.Function (($), (.), id)
-import Data.Int (Int)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
@@ -15,19 +14,16 @@ import Data.String (IsString(..))
 import GHC.Exts (IsList(..))
 import Prelude ((+), pred)
 import Text.Show (Show(..))
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as TL
 
 import Language.Symantic.Document.Sym
 
 -- * Type 'Dim'
 data Dim
  =   Dim
- {   dim_width       :: Int -- ^ Maximun line length.
- ,   dim_height      :: Int -- ^ Number of newlines.
- ,   dim_width_first :: Int -- ^ Length of the first line.
- ,   dim_width_last  :: Int -- ^ Length of the last line.
+ {   dim_width       :: Nat -- ^ Maximun line length.
+ ,   dim_height      :: Nat -- ^ Number of newlines.
+ ,   dim_width_first :: Nat -- ^ Nat of the first line.
+ ,   dim_width_last  :: Nat -- ^ Nat of the last line.
  } deriving (Eq, Show)
 instance Semigroup Dim where
 	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
@@ -45,11 +41,11 @@ instance Monoid Dim where
 -- * Type 'Reader'
 data Reader
  =   Reader
- {   reader_indent      :: !(Indent Dimension) -- ^ Current indentation level, used by 'newline'.
- ,   reader_newline     :: Dimension           -- ^ How to display 'newline'.
- ,   reader_wrap_column :: !(Column Dimension) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
- ,   reader_colorable   :: !Bool               -- ^ Whether colors are activated or not.
- ,   reader_decorable   :: !Bool               -- ^ Whether decorations are activated or not.
+ {   reader_indent      :: !Indent   -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: Dimension -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !Column   -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_colorable   :: !Bool     -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool     -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -57,13 +53,13 @@ defReader :: Reader
 defReader = Reader
  { reader_indent      = 0
  , reader_newline     = newlineWithIndent
- , reader_wrap_column = 80
+ , reader_wrap_column = Nat 80
  , reader_colorable   = True
  , reader_decorable   = True
  }
 
 -- * Type 'State'
-type State = Column Dimension
+type State = Column
 
 defState :: State
 defState = 0
@@ -76,8 +72,6 @@ newtype Dimension
                      (State -> Dim -> Dim) -> -- normal continuation
                      (State -> Dim -> Dim) -> -- should-wrap continuation
                      Dim }
-type instance Column Dimension = Int
-type instance Indent Dimension = Int
 
 dim :: Dimension -> Dim
 dim (Dimension p) = p defReader defState oko oko
@@ -102,7 +96,7 @@ instance Monoid Dimension where
 instance IsString Dimension where
 	fromString = string
 
-writeH :: Column Dimension -> Dimension
+writeH :: Column -> Dimension
 writeH len =
 	Dimension $ \ro col ok ko ->
 		let newCol = col + len in
@@ -117,9 +111,9 @@ writeH len =
 instance Textable Dimension where
 	empty     = Dimension $ \_ro st ok _ko -> ok st mempty
 	charH   _ = writeH 1
-	stringH t = writeH $ List.length t
-	textH   t = writeH $ Text.length t
-	ltextH  t = writeH $ intOfInt64 $ TL.length t
+	stringH   = writeH . length
+	textH     = writeH . length
+	ltextH    = writeH . length
 	int       = stringH . show
 	integer   = stringH . show
 	replicate cnt p | cnt <= 0  = empty
diff --git a/symantic-document/Language/Symantic/Document/Term/IO.hs b/symantic-document/Language/Symantic/Document/Term/IO.hs
index 5bbe4df..e3ba250 100644
--- a/symantic-document/Language/Symantic/Document/Term/IO.hs
+++ b/symantic-document/Language/Symantic/Document/Term/IO.hs
@@ -6,20 +6,17 @@ module Language.Symantic.Document.Term.IO
 import Control.Applicative (Applicative(..))
 import Data.Bool
 import Data.Function (($), (.), id)
-import Data.Int (Int)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
 import GHC.Exts (IsList(..))
-import Prelude ((+), pred)
+import Prelude (pred, fromIntegral, Num(..))
 import System.Console.ANSI
 import System.IO (IO)
 import Text.Show (Show(..))
 import qualified Data.List as List
-import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
-import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
 import qualified System.IO as IO
 
@@ -28,13 +25,13 @@ import Language.Symantic.Document.Sym
 -- * Type 'Reader'
 data Reader
  =   Reader
- {   reader_indent      :: !(Indent TermIO) -- ^ Current indentation level, used by 'newline'.
- ,   reader_newline     :: TermIO           -- ^ How to display 'newline'.
- ,   reader_wrap_column :: !(Column TermIO) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
- ,   reader_sgr         :: ![SGR]           -- ^ Active ANSI codes.
- ,   reader_handle      :: !IO.Handle       -- ^ Where to write.
- ,   reader_colorable   :: !Bool            -- ^ Whether colors are activated or not.
- ,   reader_decorable   :: !Bool            -- ^ Whether decorations are activated or not.
+ {   reader_indent      :: !Indent    -- ^ Current indentation level, used by 'newline'.
+ ,   reader_newline     :: TermIO     -- ^ How to display 'newline'.
+ ,   reader_wrap_column :: !Column    -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
+ ,   reader_sgr         :: ![SGR]     -- ^ Active ANSI codes.
+ ,   reader_handle      :: !IO.Handle -- ^ Where to write.
+ ,   reader_colorable   :: !Bool      -- ^ Whether colors are activated or not.
+ ,   reader_decorable   :: !Bool      -- ^ Whether decorations are activated or not.
  }
 
 -- | Default 'Reader'.
@@ -42,7 +39,7 @@ defReader :: Reader
 defReader = Reader
  { reader_indent      = 0
  , reader_newline     = newlineWithIndent
- , reader_wrap_column = 80
+ , reader_wrap_column = Nat 80
  , reader_sgr         = []
  , reader_handle      = IO.stdout
  , reader_colorable   = True
@@ -50,7 +47,7 @@ defReader = Reader
  }
 
 -- * Type 'State'
-type State = Column TermIO
+type State = Column
 
 -- | Default 'State'.
 defState :: State
@@ -64,9 +61,6 @@ newtype TermIO
                   (State -> IO () -> IO ()) -> -- should-wrap continuation
                   IO () }
 
-type instance Column TermIO = Int
-type instance Indent TermIO = Int
-
 -- | Write a 'TermIO'.
 runTermIO :: IO.Handle -> TermIO -> IO ()
 runTermIO h (TermIO p) = p defReader{reader_handle=h} defState oko oko
@@ -91,7 +85,7 @@ instance Monoid TermIO where
 instance IsString TermIO where
 	fromString = string
 
-writeH :: Column TermIO -> (IO.Handle -> IO ()) -> TermIO
+writeH :: Column -> (IO.Handle -> IO ()) -> TermIO
 writeH len t =
 	TermIO $ \ro st ok ko ->
 		let newCol = st + len in
@@ -101,9 +95,9 @@ writeH len t =
 instance Textable TermIO where
 	empty     = TermIO $ \_ro st ok _ko -> ok st mempty
 	charH   t = writeH 1 (`IO.hPutChar` t)
-	stringH t = writeH (List.length t) (`IO.hPutStr` t)
-	textH   t = writeH (Text.length t) (`Text.hPutStr` t)
-	ltextH  t = writeH (intOfInt64 $ TL.length t) (`TL.hPutStr` t)
+	stringH t = writeH (length t) (`IO.hPutStr` t)
+	textH   t = writeH (length t) (`Text.hPutStr` t)
+	ltextH  t = writeH (length t) (`TL.hPutStr` t)
 	int       = stringH . show
 	integer   = stringH . show
 	replicate cnt p | cnt <= 0  = empty
@@ -120,7 +114,7 @@ instance Alignable TermIO where
 	newlineWithIndent = TermIO $ \ro@Reader{reader_handle=h} _st ok _ko ->
 		ok (reader_indent ro) $ do
 			IO.hPutChar h '\n'
-			IO.hPutStr h $ List.replicate (reader_indent ro) ' '
+			IO.hPutStr h $ List.replicate (fromIntegral $ reader_indent ro) ' '
 instance Wrapable TermIO where
 	ifWrap y x = TermIO $ \ro st ok ko ->
 		unTermIO x ro st ok (\_sx _tx -> unTermIO y ro st ok ko)
diff --git a/symantic-document/test/HUnit.hs b/symantic-document/test/HUnit.hs
index 04cafd7..f3fabdf 100644
--- a/symantic-document/test/HUnit.hs
+++ b/symantic-document/test/HUnit.hs
@@ -12,7 +12,6 @@ import Data.Int (Int)
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String)
-import Prelude (Num)
 import Text.Show (Show(..))
 import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
@@ -110,10 +109,10 @@ be :: Doc.Wrapable d => [d] -> d
 be = Doc.foldWith Doc.breakableEmpty
 bs :: Doc.Wrapable d => [d] -> d
 bs = Doc.foldWith Doc.breakableSpace
-wc :: Doc.Wrapable d => Doc.Column d -> d -> d
+wc :: Doc.Wrapable d => Doc.Column -> d -> d
 wc = Doc.withWrapColumn
 
-fun :: (Doc.Alignable d, Doc.Wrapable d, Num (Doc.Indent d)) => d -> d
+fun :: (Doc.Alignable d, Doc.Wrapable d) => d -> d
 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifWrap (Doc.newline<>x<>Doc.newline) x) <> ")"
 
 listHorV :: (Doc.Alignable d, Doc.Wrapable d) => [d] -> d
-- 
2.44.1


From 0d1483bfd23fb1e8a0c133e59de3536266cb3e05 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Thu, 8 Mar 2018 03:25:12 +0100
Subject: [PATCH 15/16] Rename Dim -> Dimension.

---
 .../Language/Symantic/Document/Term/{Dim.hs => Dimension.hs}  | 4 ++--
 symantic-document/symantic-document.cabal                     | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)
 rename symantic-document/Language/Symantic/Document/Term/{Dim.hs => Dimension.hs} (98%)

diff --git a/symantic-document/Language/Symantic/Document/Term/Dim.hs b/symantic-document/Language/Symantic/Document/Term/Dimension.hs
similarity index 98%
rename from symantic-document/Language/Symantic/Document/Term/Dim.hs
rename to symantic-document/Language/Symantic/Document/Term/Dimension.hs
index 1a1e653..848941c 100644
--- a/symantic-document/Language/Symantic/Document/Term/Dim.hs
+++ b/symantic-document/Language/Symantic/Document/Term/Dimension.hs
@@ -1,6 +1,6 @@
-module Language.Symantic.Document.Term.Dim
+module Language.Symantic.Document.Term.Dimension
  ( module Language.Symantic.Document.Sym
- , module Language.Symantic.Document.Term.Dim
+ , module Language.Symantic.Document.Term.Dimension
  ) where
 
 import Control.Applicative (Applicative(..))
diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index 9bf2c64..d9b1710 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -30,7 +30,7 @@ Library
   exposed-modules:
     Language.Symantic.Document.Sym
     Language.Symantic.Document.Term
-    Language.Symantic.Document.Term.Dim
+    Language.Symantic.Document.Term.Dimension
     Language.Symantic.Document.Term.IO
   default-language: Haskell2010
   default-extensions:
-- 
2.44.1


From b3ac51824a8109547b02506f0627ad19096fe1d3 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic@autogeree.net>
Date: Thu, 8 Mar 2018 03:41:00 +0100
Subject: [PATCH 16/16] Add Language.Symantic.Document (again).

---
 symantic-document/Language/Symantic/Document.hs | 4 ++++
 symantic-document/symantic-document.cabal       | 1 +
 2 files changed, 5 insertions(+)
 create mode 100644 symantic-document/Language/Symantic/Document.hs

diff --git a/symantic-document/Language/Symantic/Document.hs b/symantic-document/Language/Symantic/Document.hs
new file mode 100644
index 0000000..9883c3a
--- /dev/null
+++ b/symantic-document/Language/Symantic/Document.hs
@@ -0,0 +1,4 @@
+module Language.Symantic.Document
+ ( module Language.Symantic.Document.Sym
+ ) where
+import Language.Symantic.Document.Sym
diff --git a/symantic-document/symantic-document.cabal b/symantic-document/symantic-document.cabal
index d9b1710..e2e3611 100644
--- a/symantic-document/symantic-document.cabal
+++ b/symantic-document/symantic-document.cabal
@@ -28,6 +28,7 @@ source-repository head
 
 Library
   exposed-modules:
+    Language.Symantic.Document
     Language.Symantic.Document.Sym
     Language.Symantic.Document.Term
     Language.Symantic.Document.Term.Dimension
-- 
2.44.1