From 7da8641890877137ab40fa588df4cf41eca7d4ab Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+hcompta@autogeree.net>
Date: Wed, 21 Jun 2017 20:55:34 +0200
Subject: [PATCH] Use symantic-document instead of walderleijen-ansi-text.

---
 lcc/.ghci                      |  23 +-
 lcc/Hcompta/LCC.hs             |   4 +-
 lcc/Hcompta/LCC/Document.hs    | 450 +++++++++++++++++++++++
 lcc/Hcompta/LCC/Load.hs        |   9 +-
 lcc/Hcompta/LCC/Megaparsec.hs  |  21 +-
 lcc/Hcompta/LCC/Posting.hs     |  11 +-
 lcc/Hcompta/LCC/Transaction.hs |   4 +
 lcc/Hcompta/LCC/Write.hs       | 647 ---------------------------------
 lcc/hcompta-lcc.cabal          |  15 +-
 lcc/stack.yaml                 |   2 +
 10 files changed, 502 insertions(+), 684 deletions(-)
 create mode 100644 lcc/Hcompta/LCC/Document.hs
 delete mode 100644 lcc/Hcompta/LCC/Write.hs

diff --git a/lcc/.ghci b/lcc/.ghci
index 32ffff5..db38c16 100644
--- a/lcc/.ghci
+++ b/lcc/.ghci
@@ -1,15 +1,20 @@
-import Data.List
-import Language.Symantic.Parsing as Sym
+import Control.Applicative
 import Data.Either
-import Data.String
+import Data.Functor.Compose
 import Data.Functor.Identity
-import Text.Megaparsec
-import Control.Applicative
+import Data.List
+import Data.String
 import Prelude
-import qualified Hcompta as H
-import Data.Functor.Compose
+import System.IO (IO)
+import Text.Megaparsec
 import qualified Data.MonoTraversable as MT
 import qualified Data.Text.Lazy    as TL
 import qualified Data.Text.Lazy.IO as TL
-:set -XFlexibleContexts
-:set -XOverloadedStrings
+import qualified System.IO as IO
+
+import qualified Language.Symantic.Document as D
+import qualified Hcompta as H
+
+:m Hcompta.LCC as LCC
+
+:set -Wno-type-defaults
diff --git a/lcc/Hcompta/LCC.hs b/lcc/Hcompta/LCC.hs
index 5a31b2a..7bb7a25 100644
--- a/lcc/Hcompta/LCC.hs
+++ b/lcc/Hcompta/LCC.hs
@@ -3,6 +3,7 @@ module Hcompta.LCC
  , module Hcompta.LCC.Amount
  , module Hcompta.LCC.Chart
  , module Hcompta.LCC.Compta
+ , module Hcompta.LCC.Document
  , module Hcompta.LCC.Grammar
  , module Hcompta.LCC.Journal
  , module Hcompta.LCC.Name
@@ -10,13 +11,13 @@ module Hcompta.LCC
  , module Hcompta.LCC.Read
  , module Hcompta.LCC.Tag
  , module Hcompta.LCC.Transaction
- , module Hcompta.LCC.Write
  ) where
 
 import Hcompta.LCC.Account
 import Hcompta.LCC.Amount
 import Hcompta.LCC.Chart
 import Hcompta.LCC.Compta
+import Hcompta.LCC.Document
 import Hcompta.LCC.Grammar
 import Hcompta.LCC.Journal
 import Hcompta.LCC.Name
@@ -24,4 +25,3 @@ import Hcompta.LCC.Posting
 import Hcompta.LCC.Read
 import Hcompta.LCC.Tag
 import Hcompta.LCC.Transaction
-import Hcompta.LCC.Write
diff --git a/lcc/Hcompta/LCC/Document.hs b/lcc/Hcompta/LCC/Document.hs
new file mode 100644
index 0000000..975e0c1
--- /dev/null
+++ b/lcc/Hcompta/LCC/Document.hs
@@ -0,0 +1,450 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Hcompta.LCC.Document where
+
+-- import Control.Monad (Monad)
+-- import Data.Time.LocalTime (TimeZone(..))
+-- import GHC.Integer.Logarithms (integerLogBase#)
+-- import qualified Control.Monad.Classes as MC
+-- import qualified Control.Monad.Trans.Reader as R
+-- import qualified Data.Time.Calendar  as Time
+-- import qualified Data.Time.LocalTime as Time
+-- import qualified Hcompta.LCC.Lib.Strict as S
+-- import qualified Text.WalderLeijen.ANSI.Text as W
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Char (Char)
+import Data.Decimal
+import Data.Eq (Eq(..))
+import Data.Foldable (Foldable(..))
+import Data.Function (($), (.), flip, id)
+import Data.Functor ((<$>))
+import Data.Functor.Compose (Compose(..))
+import Data.Maybe (Maybe(..), maybe)
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Tuple (fst)
+import GHC.Exts (Int(..))
+import Prelude (Integer, Num(..), RealFrac(..), Show(..), Integral(..), fromIntegral)
+import qualified Data.ByteString as BS
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.MonoTraversable as MT
+import qualified Data.NonNull as NonNull
+import qualified Data.Strict as S
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Enc
+import qualified Data.TreeMap.Strict as TreeMap
+
+import qualified Language.Symantic.Document as D
+
+import qualified Hcompta as H
+
+import Hcompta.LCC.Account
+import Hcompta.LCC.Amount
+import Hcompta.LCC.Chart
+import Hcompta.LCC.Journal
+import Hcompta.LCC.Name
+import Hcompta.LCC.Posting
+import Hcompta.LCC.Tag
+import Hcompta.LCC.Transaction
+import Hcompta.LCC.Grammar
+import Hcompta.LCC.Compta
+
+-- import Debug.Trace (trace)
+-- dbg msg x = trace (msg <> " = " <> show x) x
+
+-- * Type 'Context_Write'
+data Context_Write
+ =   Context_Write
+ {   context_write_account_ref    :: Bool
+ ,   context_write_amounts        :: Style_Amounts
+ ,   context_write_width_acct_amt :: Int
+ }
+
+context_write :: Context_Write
+context_write =
+	Context_Write
+	 { context_write_account_ref    = True
+	 , context_write_amounts        = Style_Amounts Map.empty
+	 , context_write_width_acct_amt = 0
+	 }
+
+-- * Document 'Date'
+d_date dat =
+	let (y, mo, d) = H.date_gregorian dat in
+	(if y == 0 then D.empty else D.integer y <> sep char_ymd_sep) <>
+	int2 mo <>
+	sep char_ymd_sep <> int2 d <>
+	(case H.date_tod dat of
+	 (0, 0, 0) -> D.empty
+	 (h, m, s) ->
+		sep '_' <> int2 h <>
+		sep ':' <> int2 m <>
+		(case s of
+		 0 -> D.empty
+		 _ -> sep ':' <>
+			(if s < 10 then D.charH '0' else D.empty) <>
+			D.integer ((truncate s::Integer))))
+	where
+	int2 i = (if i < 10 then D.charH '0' else D.empty) <> D.int i
+	sep = D.blacker . D.charH
+
+-- * Document 'Account'
+d_account (acct::Account) =
+	(`MT.ofoldMap` acct) $ \a ->
+		D.blacker (D.charH char_account_sep) <>
+		d_account_section a
+w_account = D.width . D.dim . d_account
+
+d_account_section = D.textH . unName
+
+-- ** Document 'Account_Ref'
+d_account_ref (Tag_Path path) =
+	D.catH $
+		(:) (op $ D.charH char_account_tag_prefix) $
+		List.intersperse
+		 (op $ D.charH char_tag_sep)
+		 (D.textH . unName <$> NonNull.toNullable path)
+	where op = D.yellower
+w_account_ref = D.width . D.dim . d_account_ref
+
+-- ** Document 'Account_Tag'
+d_account_tag (Account_Tag (Tag (Tag_Path path) (Tag_Data value))) =
+	D.catH (
+		(:) (op $ D.charH char_account_tag_prefix) $
+		List.intersperse
+		 (op $ D.charH char_tag_sep)
+		 (D.textH . unName <$> NonNull.toNullable path) ) <>
+	if Text.null value
+	then D.empty
+	else
+		op (D.charH char_tag_data_prefix) <>
+		D.textH value
+	where op = D.yellower
+
+-- * Document 'Amount'
+d_amount
+ ( sty@(Style_Amount
+	 { style_amount_unit_side=uside
+	 , style_amount_unit_spaced=uspaced
+	 })
+ , Amount u q ) =
+	case uside of
+	 S.Just L ->
+		d_unit u <>
+		case uspaced of
+		 S.Just True | u /= H.unit_empty -> D.space
+		 _ -> D.empty
+	 _ -> D.empty
+	<> d_quantity (sty, q)
+	<> case uside of
+	 S.Just R ->
+		(case uspaced of
+		 S.Just True | u /= H.unit_empty -> D.space
+		 _ -> D.empty) <>
+		d_unit u
+	 S.Nothing ->
+		(case uspaced of
+		 S.Just True | u /= H.unit_empty -> D.space
+		 _ -> D.empty) <>
+		d_unit u
+	 _ -> D.empty
+w_amount = D.width . D.dim . d_amount
+
+-- * Document 'Unit'
+d_unit u =
+	let t = H.unit_text u in
+	D.yellow $
+	if Text.all
+	 (\c -> case Char.generalCategory c of
+		 Char.CurrencySymbol  -> True
+		 Char.LowercaseLetter -> True
+		 Char.ModifierLetter  -> True
+		 Char.OtherLetter     -> True
+		 Char.TitlecaseLetter -> True
+		 Char.UppercaseLetter -> True
+		 _ -> False
+	 ) t
+	then D.textH t
+	else D.dquote $ D.textH t
+
+-- * Document 'Quantity'
+d_quantity
+ ( Style_Amount
+	 { style_amount_fractioning
+	 , style_amount_grouping_integral
+	 , style_amount_grouping_fractional
+	 }
+ , qty ) = do
+	let Decimal e n = qty
+	let num = show $ abs n
+	let sign = D.bold $ D.yellow $ D.textH (if n < 0 then "-" else "")
+	if e == 0
+	 then sign <> D.bold (D.blue $ D.stringH num)
+	 else do
+		let num_len = List.length num
+		let padded =
+			List.concat
+			 [ List.replicate (fromIntegral e + 1 - num_len) '0'
+			 , num
+			 -- , replicate (fromIntegral precision - fromIntegral e) '0'
+			 ]
+		let (int, frac) = List.splitAt (max 1 (num_len - fromIntegral e)) padded
+		let default_fractioning =
+			List.head $
+			del_grouping_sep style_amount_grouping_integral $
+			del_grouping_sep style_amount_grouping_fractional $
+			['.', ',']
+		sign <>
+		 D.bold (D.blue $
+			D.stringH (S.maybe id
+			 (\g -> List.reverse . group g . List.reverse)
+			 style_amount_grouping_integral $ int) <>
+			D.yellow (D.charH (S.fromMaybe default_fractioning style_amount_fractioning)) <>
+			D.stringH (S.maybe id group style_amount_grouping_fractional frac))
+	where
+	group :: Style_Amount_Grouping -> [Char] -> [Char]
+	group (Style_Amount_Grouping sep sizes_) =
+		List.concat . List.reverse .
+		List.map List.reverse . fst .
+		List.foldl'
+		 (flip (\digit x -> case x of
+			 ([], sizes) -> ([[digit]], sizes)
+			 (digits:groups, []) -> ((digit:digits):groups, [])
+			 (digits:groups, curr_sizes@(size:sizes)) ->
+				if List.length digits < size
+				then (      (digit:digits):groups, curr_sizes)
+				else ([digit]:[sep]:digits:groups, if List.null sizes then curr_sizes else sizes)
+		 ))
+		 ([], sizes_)
+	del_grouping_sep grouping =
+		case grouping of
+		 S.Just (Style_Amount_Grouping sep _) -> List.delete sep
+		 _ -> id
+
+-- * Document 'Comment'
+d_comment (Comment com) =
+	D.cyan $
+		D.charH char_comment_prefix
+		<> (case Text.uncons com of
+		 Just (c, _) | not $ Char.isSpace c -> D.space
+		 _ -> D.empty)
+		<> D.textH com
+
+d_comments prefix =
+	D.catH .
+	List.intersperse D.eol .
+	List.map (\c -> prefix <> d_comment c)
+
+-- * Document 'Posting'
+d_posting ctx
+ Posting
+ { posting_account
+ , posting_account_ref
+ , posting_amounts
+ , posting_comments
+ -- , posting_dates
+ -- , posting_tags
+ } =
+	let d_indent = D.spaces 2 in
+	d_indent <>
+	let (doc_acct, w_acct) =
+		case posting_account_ref of
+		 S.Just (a S.:!: sa) | context_write_account_ref ctx ->
+			( d_account_ref a <> S.maybe D.empty d_account sa
+			, w_account_ref a +  S.maybe 0       w_account sa )
+		 _ -> (d_account posting_account, w_account posting_account) in
+	(case posting_amounts of
+	 Amounts amts | Map.null amts -> doc_acct
+	 Amounts amts ->
+		maybe D.empty id $
+		Map.foldlWithKey
+		 (\mdoc unit qty -> Just $
+			let amt = styled_amount (context_write_amounts ctx) $ Amount unit qty in
+			let pad = max 0 $ context_write_width_acct_amt ctx - (w_acct + w_amount amt) in
+			(case mdoc of
+			 Nothing -> D.empty
+			 Just doc -> doc <> D.eol <> d_indent) <>
+			doc_acct <> D.spaces pad <> D.space <> d_amount amt
+		 ) Nothing amts) <>
+	(case posting_comments of
+	 []  -> D.empty
+	 [c] -> D.space <> d_comment c
+	 _   -> D.eol   <> d_comments (d_indent <> D.space) posting_comments)
+w_posting  ctx = D.width . D.dim . d_posting ctx
+
+-- * Document 'Transaction'
+d_transaction ctx
+ t@Transaction
+ { transaction_comments
+ , transaction_dates
+ , transaction_wording  = Wording transaction_wording
+ , transaction_postings = Postings transaction_postings
+ , transaction_tags     = Transaction_Tags (Tags tags)
+ } =
+	let ctx' = ctx { context_write_width_acct_amt =
+		let w = context_write_width_acct_amt ctx in
+		if w == 0
+		then w_postings_acct_amt ctx t
+		else w } in
+	D.catH (
+		List.intersperse
+		 (D.charH char_transaction_date_sep)
+		 (d_date <$> NonNull.toNullable transaction_dates)) <>
+	(case transaction_wording of
+	 "" -> D.empty
+	 _  -> D.space <> D.magenta (D.textH transaction_wording)) <>
+	D.eol <>
+	(case transaction_comments of
+	 [] -> D.empty
+	 _  -> d_comments D.space transaction_comments <> D.eol) <>
+	TreeMap.foldr_with_Path
+	 (\path -> flip $
+		foldr (\value -> (<>) (D.spaces 2 <>
+		d_transaction_tag (Transaction_Tag (Tag (Tag_Path path) value)) <> D.eol)))
+	 D.empty tags <>
+	D.catV (d_posting ctx' <$> Compose transaction_postings)
+
+d_transactions ctx j =
+	let ctx' = ctx{context_write_width_acct_amt =
+		foldr (max . w_postings_acct_amt ctx) 0 j} in
+	maybe D.empty id $
+	foldr (\t mdoc -> Just $
+		d_transaction ctx' t <>
+		case mdoc of
+		 Nothing  -> D.eol
+		 Just doc -> D.eol <> D.eol <> doc
+	 ) Nothing j
+
+-- w_postings ctx = MT.ofoldr (max . w_posting ctx) 0
+-- | Return the width of given 'Postings',
+-- considering only 'Account's and 'Amount's (not indentation, 'Comment's, nor 'Posting_Tag's).
+w_postings_acct_amt :: H.Get Postings a => Context_Write -> a -> Int
+w_postings_acct_amt ctx =
+	MT.ofoldr (\Posting
+	 { posting_account
+	 , posting_account_ref
+	 , posting_amounts
+	 } -> max $
+		let w_acct =
+			case posting_account_ref of
+			 S.Just (a S.:!: sa) | context_write_account_ref ctx ->
+				w_account_ref a + S.maybe 0 w_account sa
+			 _ -> w_account posting_account in
+		let w_amt =
+			case posting_amounts of
+			 Amounts amts | Map.null amts -> 0
+			 Amounts amts ->
+				Map.foldrWithKey
+				 (\unit qty -> max $
+					let amt = styled_amount (context_write_amounts ctx) $ Amount unit qty in
+					w_amount amt)
+				 1 amts in
+		w_acct + w_amt
+	 ) 0 .
+	H.get @Postings
+
+-- ** Document 'Transaction_Tag'
+d_transaction_tag (Transaction_Tag (Tag (Tag_Path path) (Tag_Data value))) =
+	D.catH (
+		(:) (op $ D.charH char_tag_prefix) $
+		List.intersperse
+		 (op $ D.charH char_tag_sep)
+		 (d_transaction_tag_section <$> NonNull.toNullable path)) <>
+	if Text.null value
+	then D.empty
+	else op (D.charH char_tag_data_prefix) <> D.textH value
+	where
+	op = D.yellower
+
+d_transaction_tag_section = D.bold . D.textH . unName
+
+-- * Document 'Journal'
+d_journal ctx jnl =
+	d_transactions ctx $
+	Compose $ journal_content jnl
+
+-- * Document 'Journals'
+d_journals ctx (Journals js) =
+	Map.foldl
+	 (\doc j@Journal{journal_file=PathFile jf, journal_content=jc} ->
+		doc <>
+		d_comment (Comment $ Text.pack jf) <> D.eol <>
+		if null jc then D.empty else (D.eol <> d_journal ctx j)
+	 ) D.empty js
+
+-- * Document 'Chart'
+d_chart =
+	TreeMap.foldl_with_Path
+	 (\doc acct (Account_Tags (Tags ca)) ->
+		doc <>
+		d_account (H.get acct) <> D.eol <>
+		TreeMap.foldl_with_Path
+		 (\doc' tp tvs ->
+			doc' <>
+			foldl'
+			 (\doc'' tv ->
+				doc'' <> D.spaces 2 <>
+				d_account_tag (Account_Tag (Tag (Tag_Path tp) tv)) <>
+				D.eol)
+			 D.empty
+			 tvs)
+		 D.empty
+		 ca
+	 ) D.empty .
+	chart_accounts
+
+-- * Document 'Terms'
+d_terms (ts::Terms) =
+	Map.foldl (\doc t -> doc <> D.text t <> D.eol) D.empty ts
+
+-- * Document 'Compta'
+d_compta ctx Compta
+ { compta_journals=js
+ , compta_chart=c@Chart{chart_accounts=ca}
+ , compta_style_amounts=amts
+ , compta_terms=ts
+ } =
+	(if null ts then D.empty else (d_terms ts <> D.eol)) <>
+	(if TreeMap.null ca then D.empty else (d_chart c <> D.eol)) <>
+	d_journals ctx{context_write_amounts=context_write_amounts ctx <> amts} js
+
+-- * Document 'SourcePos'
+d_sourcepos (SourcePos p (PosFile l) (PosFile c)) = do
+	content <- Enc.decodeUtf8 <$> BS.readFile p
+	let ls = Text.lines content
+	let ll = max 1 $ l - size_ctx
+	let qs =
+		List.take (intFrom $ (l - ll) + 1 + size_ctx) $
+		List.drop (intFrom $ ll-1) ls
+	let ns = show <$> List.take (List.length qs) [ll..]
+	let max_len_n = maximum $ 0 : (List.length <$> ns)
+	let ns' = (<$> ns) $ \n ->
+		List.replicate (max_len_n - List.length n) ' ' <> n
+	let quote =
+		D.catV $
+		List.zipWith (\(n, sn) q ->
+			D.spaces 2 <> D.blacker (D.stringH sn) <>
+			D.spaces 2 <> (if n == l then mark q else D.textH q)
+		 ) (List.zip [ll..] ns') qs
+	return $ quote <> D.eol
+	where
+	size_ctx = 2
+	intFrom = fromInteger . toInteger
+	mark q =
+		let (b, a) = Text.splitAt (intFrom c - 1) q in
+		D.textH b <>
+		case Text.uncons a of
+		 Nothing -> D.red D.space
+		 Just (a0, a') -> D.red (D.charH a0) <> D.textH a'
diff --git a/lcc/Hcompta/LCC/Load.hs b/lcc/Hcompta/LCC/Load.hs
index ad9fd17..8c153dd 100644
--- a/lcc/Hcompta/LCC/Load.hs
+++ b/lcc/Hcompta/LCC/Load.hs
@@ -22,6 +22,7 @@ import qualified Data.Strict as S
 import qualified System.Environment as Env
 -- import qualified Text.Megaparsec as P
 
+import qualified Language.Symantic.Document as Doc
 -- import Language.Symantic.Grammar
 -- import Language.Symantic as Sym
 -- import qualified Language.Symantic.Lib as Sym
@@ -31,7 +32,7 @@ import qualified Hcompta.LCC.Sym as LCC.Sym
 import Hcompta.LCC.Megaparsec (showParseError)
 -- import Hcompta.LCC.Grammar
 import Hcompta.LCC.Read
-import Hcompta.LCC.Write
+import Hcompta.LCC.Document
 
 -- import Control.Applicative (Applicative(..))
 -- import Data.Functor (Functor(..))
@@ -50,12 +51,12 @@ main = do
 		readCompta @SRC @SS arg >>= \case
 		 Left (Error_Read_Syntax err) ->
 			showParseError err >>=
-			writeIO style_write stderr
+			(`Doc.ansiIO` stderr)
 		 Left (Error_Read_Semantic err) -> error $ show err
 		 Right r -> do
 			-- print r
-			writeIO style_write stdout $
-				write_compta context_write r
+			(`Doc.ansiIO` stdout) $
+				d_compta context_write r
 
 printError :: Show err => Either err a -> IO a
 printError (Left err) = error $ show err
diff --git a/lcc/Hcompta/LCC/Megaparsec.hs b/lcc/Hcompta/LCC/Megaparsec.hs
index 2fd2bd6..55a29ec 100644
--- a/lcc/Hcompta/LCC/Megaparsec.hs
+++ b/lcc/Hcompta/LCC/Megaparsec.hs
@@ -42,17 +42,17 @@ import qualified Data.Text.Encoding as Enc
 import qualified System.Directory as IO
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Prim as P
-import qualified Text.WalderLeijen.ANSI.Text as W
 
 import Language.Symantic.Grammar as Sym
 import qualified Language.Symantic as Sym
+import qualified Language.Symantic.Document as D
 
 import Hcompta.LCC.Amount
 import Hcompta.LCC.Chart
 import Hcompta.LCC.Posting
 import Hcompta.LCC.Journal
 import Hcompta.LCC.Grammar as LCC
-import Hcompta.LCC.Write
+import Hcompta.LCC.Document
 
 import Debug.Trace (trace)
 import Data.Semigroup ((<>))
@@ -390,20 +390,21 @@ sourcePosStackPretty ms = concatMap f rest ++ P.sourcePosPretty pos
 showParseError ::
  ( Ord t
  , P.ShowToken t
- , P.ShowErrorComponent e )
- => P.ParseError t e
- -> IO W.Doc
+ , P.ShowErrorComponent e
+ , D.Doc_Text d
+ , D.Doc_Color d
+ , D.Doc_Decoration d
+ ) => P.ParseError t e -> IO d
 showParseError err = do
 	let (pos:|_) = P.errorPos err
-	q <- write_sourcepos $ sourcePos pos
-	return $ W.vcat
-	 [ W.strict_text (Text.pack $ sourcePosStackPretty $ P.errorPos err) W.<> ":"
-	 , W.strict_text $ Text.pack $ parseErrorTextPretty err
+	q <- d_sourcepos $ sourcePos pos
+	return $ D.catV
+	 [ D.stringH (sourcePosStackPretty $ P.errorPos err) <> ":"
+	 , D.stringH $ parseErrorTextPretty err
 	 , q
 	 ]
 
 -- | Transforms list of error messages into their textual representation.
-
 messageItemsPretty :: P.ShowErrorComponent a => String -> Set a -> String
 messageItemsPretty prefix ts
  | Set.null ts = ""
diff --git a/lcc/Hcompta/LCC/Posting.hs b/lcc/Hcompta/LCC/Posting.hs
index f229785..f996514 100644
--- a/lcc/Hcompta/LCC/Posting.hs
+++ b/lcc/Hcompta/LCC/Posting.hs
@@ -14,7 +14,7 @@ module Hcompta.LCC.Posting where
 import Control.DeepSeq (NFData(..))
 import Data.Data (Data(..))
 import Data.Eq (Eq(..))
-import Data.Function (($), (.), flip)
+import Data.Function (($), (.), flip, id)
 import Data.Functor ((<$>))
 import Data.Functor.Compose (Compose(..))
 import Data.Map.Strict (Map)
@@ -36,9 +36,9 @@ import qualified Data.TreeMap.Strict as TreeMap
 
 import qualified Hcompta as H
 
-import           Hcompta.LCC.Account
-import           Hcompta.LCC.Amount
-import           Hcompta.LCC.Tag
+import Hcompta.LCC.Account
+import Hcompta.LCC.Amount
+import Hcompta.LCC.Tag
 
 deriving instance (Data a, Data b) => Data (S.Pair a b)
 instance (NFData a, NFData b) => NFData (S.Pair a b) where
@@ -151,6 +151,9 @@ newtype Postings = Postings (Map Account [Posting])
  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 unPostings :: Postings -> Map Account [Posting]
 unPostings (Postings ps) = ps
+type instance H.Postings H.:@ Postings = Postings
+instance H.Get Postings Postings where
+	get = id
 instance H.Postings Postings
 instance Semigroup Postings where
 	Postings x <> Postings y =
diff --git a/lcc/Hcompta/LCC/Transaction.hs b/lcc/Hcompta/LCC/Transaction.hs
index 50fe5de..edc97c4 100644
--- a/lcc/Hcompta/LCC/Transaction.hs
+++ b/lcc/Hcompta/LCC/Transaction.hs
@@ -65,6 +65,10 @@ instance MT.MonoFoldable Transaction where
 	ofoldr1Ex f  = MT.ofoldr1Ex f  . transaction_postings
 	ofoldl1Ex' f = MT.ofoldl1Ex' f . transaction_postings
 
+type instance H.Postings H.:@ Transaction = Postings
+instance H.Get Postings Transaction where
+	get = transaction_postings
+
 type instance H.Date H.:@ Transaction = Date
 instance H.GetI H.Date Transaction where
 	getI_ _ = NonNull.head . transaction_dates
diff --git a/lcc/Hcompta/LCC/Write.hs b/lcc/Hcompta/LCC/Write.hs
deleted file mode 100644
index a3c6cd1..0000000
--- a/lcc/Hcompta/LCC/Write.hs
+++ /dev/null
@@ -1,647 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-module Hcompta.LCC.Write where
-
--- import Control.Monad (Monad)
--- import Data.Time.LocalTime (TimeZone(..))
--- import qualified Control.Monad.Classes as MC
--- import qualified Control.Monad.Trans.Reader as R
--- import qualified Data.Time.Calendar  as Time
--- import qualified Data.Time.LocalTime as Time
-import Data.Bool
-import Data.Char (Char)
-import Data.Decimal
-import Data.Eq (Eq(..))
-import Data.Foldable (Foldable(..))
-import Data.Function (($), (.), flip, id)
-import Control.Monad (Monad(..))
-import Data.Functor ((<$>))
-import Data.Functor.Compose (Compose(..))
-import Data.Maybe (Maybe(..))
-import Data.Monoid ((<>))
-import Data.Ord (Ord(..))
-import Data.Tuple (fst)
-import GHC.Exts (Int(..))
-import GHC.Integer.Logarithms (integerLogBase#)
-import Prelude (Bounded(..), Integer, Num(..), RealFrac(..), Show(..), Integral(..), fromIntegral)
-import System.IO (IO, Handle)
-import Text.WalderLeijen.ANSI.Text (Doc)
-import qualified Data.Char as Char
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
-import qualified Data.MonoTraversable as MT
-import qualified Data.NonNull as NonNull
-import qualified Data.Strict as S
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as TL
-import qualified Data.TreeMap.Strict as TreeMap
-import qualified Text.WalderLeijen.ANSI.Text as W
-import qualified Data.ByteString as BS
-import qualified Data.Text.Encoding as Enc
-
-import qualified Hcompta as H
-
-import Hcompta.LCC.Account
-import Hcompta.LCC.Amount
-import Hcompta.LCC.Chart
-import Hcompta.LCC.Journal
-import Hcompta.LCC.Name
-import Hcompta.LCC.Posting
-import Hcompta.LCC.Tag
-import Hcompta.LCC.Transaction
-import Hcompta.LCC.Grammar
-import Hcompta.LCC.Compta
--- import qualified Hcompta.LCC.Lib.Strict as S
-
--- * Write 'Date'
-write_date :: Date -> Doc
-write_date dat =
-	let (y, mo, d) = H.date_gregorian dat in
-	(if y == 0 then W.empty else W.integer y <> sep char_ymd_sep) <>
-	doc_int2 mo <>
-	sep char_ymd_sep <> doc_int2 d <>
-	(case H.date_tod dat of
-	 (0, 0, 0) -> W.empty
-	 (h, m, s) ->
-		sep '_' <> doc_int2 h <>
-		sep ':' <> doc_int2 m <>
-		(case s of
-		 0 -> W.empty
-		 _ -> sep ':' <>
-			(if s < 10 then W.char '0' else W.empty) <>
-			W.strict_text (Text.pack $ show $ (truncate s::Integer)))) {-<>
-	(case tz_min of
-	 0 -> W.empty
-	 _ | tz_name /= "" -> W.space <> do W.strict_text $ Text.pack tz_name
-	 _ -> W.space <> do W.strict_text $ Text.pack $ Time.timeZoneOffsetString tz)
-	-}
-	where
-	doc_int2 :: Int -> Doc
-	doc_int2 i = if i < 10 then W.char '0' <> W.int i else W.int i
-	sep :: Char -> Doc
-	sep = gray . W.char
-
-width_date :: Date -> Int
-width_date dat = do
-	let (y, _, _) = H.date_gregorian dat
-	(case y of
-	 0 -> 0
-	 _ ->
-		(if y < 0 then 1 else 0) -- sign
-		+ (1 + (I# (integerLogBase# 10 (abs y)))) -- year
-		+ 1) -- -
-	+ 2 -- month
-	+ 1 -- -
-	+ 2 -- dom
-	+ (case H.date_tod dat of
-	 (0, 0, 0) -> 0
-	 (_, _, s) ->
-		1 -- _
-		+ 2 -- hour
-		+ 1 -- :
-		+ 2 -- min
-		+ (case s of
-		 0 -> 0
-		 _ -> 1 + 2 -- : sec
-		)
-	)
-
--- * Write 'Account'
-write_account :: Account -> Doc
-write_account =
-	MT.ofoldMap $ \a ->
-		gray (W.char char_account_sep) <>
-		write_account_section a
-
-write_account_section :: Account_Section -> Doc
-write_account_section = W.strict_text . unName
-
-width_account :: Account -> Int
-width_account =
-	MT.ofoldl'
-	 (\acc -> (1 +) . (acc +) . Text.length . unName)
-	 0
-
--- ** Write 'Account_Ref'
-write_account_ref :: Tag_Path -> Doc
-write_account_ref (Tag_Path path) =
-	W.hcat $
-		(:) (op $ W.char char_account_tag_prefix) $
-		List.intersperse
-		 (op $ W.char char_tag_sep)
-		 (W.strict_text . unName <$> NonNull.toNullable path)
-	where op = W.bold . W.dullyellow
-
-width_account_ref :: Tag_Path -> Int
-width_account_ref (Tag_Path anch) =
-	MT.ofoldl'
-	 (\acc -> (1 +) . (acc +) . MT.olength)
-	 0 anch
-
--- ** Write 'Account_Tag'
-write_account_tag :: Account_Tag -> Doc
-write_account_tag (Account_Tag (Tag (Tag_Path path) (Tag_Data value))) =
-	W.hcat (
-		(:) (op $ W.char char_account_tag_prefix) $
-		List.intersperse
-		 (op $ W.char char_tag_sep)
-		 (W.strict_text . unName <$> NonNull.toNullable path) ) <>
-	if Text.null value
-	then W.empty
-	else
-		op (W.char char_tag_data_prefix) <>
-		W.strict_text value
-	where op = W.bold . W.dullyellow
-
--- * Write 'Amount'
-write_amount :: Styled_Amount Amount -> Doc
-write_amount
- ( sty@(Style_Amount
-	 { style_amount_unit_side
-	 , style_amount_unit_spaced
-	 })
- , amt ) =
-	let unt = amount_unit amt in
-	case style_amount_unit_side of
-	 S.Just L ->
-		write_unit unt <>
-		case style_amount_unit_spaced of
-		 S.Just True | unt /= H.unit_empty -> W.space
-		 _ -> W.empty
-	 _ -> W.empty
-	<> write_quantity (sty, amount_quantity amt)
-	<> case style_amount_unit_side of
-	 (S.Just R) ->
-		(case style_amount_unit_spaced of
-		 S.Just True | unt /= H.unit_empty -> W.space
-		 _ -> W.empty) <>
-		write_unit unt
-	 S.Nothing ->
-		(case style_amount_unit_spaced of
-		 S.Just True | unt /= H.unit_empty -> W.space
-		 _ -> W.empty) <>
-		write_unit unt
-	 _ -> W.empty
-
-width_amount :: Styled_Amount Amount -> Int
-width_amount (sty@(Style_Amount { style_amount_unit_spaced }), amt) =
-	let unit = amount_unit amt in
-	width_unit unit
-	+ (case style_amount_unit_spaced of
-		 S.Just True | unit /= H.unit_empty -> 1
-		 _ -> 0)
-	+ width_quantity sty (amount_quantity amt)
-
--- * Write 'Unit'
-write_unit :: Unit -> Doc
-write_unit u =
-	let t = H.unit_text u in
-	W.yellow $
-	if Text.all
-	 (\c -> case Char.generalCategory c of
-		 Char.CurrencySymbol  -> True
-		 Char.LowercaseLetter -> True
-		 Char.ModifierLetter  -> True
-		 Char.OtherLetter     -> True
-		 Char.TitlecaseLetter -> True
-		 Char.UppercaseLetter -> True
-		 _ -> False
-	 ) t
-	then W.strict_text t
-	else W.hcat $ W.strict_text <$> ["\"", t, "\""]
-
-width_unit :: Unit -> Int
-width_unit u =
-	let t = H.unit_text u in
-	Text.length t +
-	if Text.all
-	 (\c -> case Char.generalCategory c of
-		 Char.CurrencySymbol  -> True
-		 Char.LowercaseLetter -> True
-		 Char.ModifierLetter  -> True
-		 Char.OtherLetter     -> True
-		 Char.TitlecaseLetter -> True
-		 Char.UppercaseLetter -> True
-		 _ -> False) t
-	then 0
-	else 2
-
--- * Write 'Quantity'
-write_quantity :: Styled_Amount Quantity -> Doc
-write_quantity
- ( Style_Amount
-	 { style_amount_fractioning
-	 , style_amount_grouping_integral
-	 , style_amount_grouping_fractional
-	 }
- , qty ) = do
-	let Decimal e n = qty
-	let num = show $ abs $ n
-	let sign = W.bold $ W.yellow $ W.strict_text (if n < 0 then "-" else "")
-	if e == 0
-	 then sign <> W.bold (W.blue $ W.strict_text $ Text.pack num)
-	 else do
-		let num_len = List.length num
-		let padded =
-			List.concat
-			 [ List.replicate (fromIntegral e + 1 - num_len) '0'
-			 , num
-			 -- , replicate (fromIntegral precision - fromIntegral e) '0'
-			 ]
-		let (int, frac) = List.splitAt (max 1 (num_len - fromIntegral e)) padded
-		let default_fractioning =
-			List.head $
-			del_grouping_sep style_amount_grouping_integral $
-			del_grouping_sep style_amount_grouping_fractional $
-			['.', ',']
-		sign <>
-		 W.bold (W.blue $
-			W.text (TL.pack $ S.maybe id
-			 (\g -> List.reverse . group g . List.reverse)
-			 style_amount_grouping_integral $ int) <>
-			W.yellow (W.char (S.fromMaybe default_fractioning style_amount_fractioning)) <>
-			W.text (TL.pack $ S.maybe id group style_amount_grouping_fractional frac))
-	where
-	group :: Style_Amount_Grouping -> [Char] -> [Char]
-	group (Style_Amount_Grouping sep sizes_) =
-		List.concat . List.reverse .
-		List.map List.reverse . fst .
-		List.foldl'
-		 (flip (\digit x -> case x of
-			 ([], sizes) -> ([[digit]], sizes)
-			 (digits:groups, []) -> ((digit:digits):groups, [])
-			 (digits:groups, curr_sizes@(size:sizes)) ->
-				if List.length digits < size
-				then (      (digit:digits):groups, curr_sizes)
-				else ([digit]:[sep]:digits:groups, if List.null sizes then curr_sizes else sizes)
-		 ))
-		 ([], sizes_)
-	del_grouping_sep grouping =
-		case grouping of
-		 S.Just (Style_Amount_Grouping sep _) -> List.delete sep
-		 _ -> id
-
-width_quantity :: Style_Amount -> Quantity -> Int
-width_quantity Style_Amount
- { style_amount_grouping_integral
- , style_amount_grouping_fractional
- } qty =
-	let Decimal e n     = qty in
-	let sign_len        = if n < 0 then 1 else 0 in
-	let fractioning_len = if e > 0 then 1 else 0 in
-	let num_len         = if n == 0 then 0 else (1 +) $ I# (integerLogBase# 10 (abs n)) in
-	let pad_left_len    = max 0 (fromIntegral e + 1 - num_len) in
-	-- let pad_right_len   = max 0 (fromIntegral precision - fromIntegral e) in
-	let padded_len      = pad_left_len + num_len {-+ pad_right_len-} in
-	let int_len         = max 1 (num_len - fromIntegral e) in
-	let frac_len        = max 0 (padded_len - int_len) in
-	( sign_len
-	+ fractioning_len
-	+ padded_len
-	+ S.maybe 0 (group int_len)  style_amount_grouping_integral
-	+ S.maybe 0 (group frac_len) style_amount_grouping_fractional
-	)
-	where
-	group :: Int -> Style_Amount_Grouping -> Int
-	group num_len (Style_Amount_Grouping _sep sizes_) =
-		if num_len <= 0
-		then 0
-		else loop 0 num_len sizes_
-		where
-		loop :: Int -> Int -> [Int] -> Int
-		loop pad len x =
-			case x of
-			 [] -> 0
-			 sizes@[size] ->
-				let l = len - size in
-				if l <= 0 then pad
-				else loop (pad + 1) l sizes
-			 size:sizes ->
-				let l = len - size in
-				if l <= 0 then pad
-				else loop (pad + 1) l sizes
-
--- * Write 'Comment'
-write_comment :: Comment -> Doc
-write_comment (Comment com) =
-	W.cyan $
-		W.char char_comment_prefix
-		<> (case Text.uncons com of
-		 Just (c, _) | not $ Char.isSpace c -> W.space
-		 _ -> W.empty)
-		<> W.strict_text com
-
-write_comments :: Doc -> [Comment] -> Doc
-write_comments prefix =
-	W.hcat .
-	List.intersperse W.line .
-	List.map (\c -> prefix <> write_comment c)
-
--- * Write 'Posting'
-write_posting
- :: Context_Write
- -> Posting -> Doc
-write_posting ctx
- Posting
- { posting_account
- , posting_account_ref
- , posting_amounts
- , posting_comments=cmts
- -- , posting_dates
- -- , posting_tags
- } =
-	W.string "  " <>
-	let (doc_acct, wi_acct) =
-		case posting_account_ref of
-		 S.Just (a S.:!: sa) | context_write_account_ref ctx ->
-			( write_account_ref a <> S.maybe W.empty write_account sa
-			, width_account_ref a +  S.maybe 0       width_account sa )
-		 _ ->
-			( write_account posting_account
-			, width_account posting_account ) in
-	(case posting_amounts of
-	 Amounts amts | Map.null amts -> doc_acct
-	 Amounts amts ->
-		Map.foldlWithKey
-		 (\doc unit qty ->
-			let amt = styled_amount (context_write_amounts ctx) $ Amount unit qty in
-			let wi_amt = width_amount amt in
-			doc <>
-			(if W.is_empty doc then W.empty else W.line <> W.string "  ") <>
-			doc_acct <>
-			W.fill (context_write_max_posting_width ctx - (wi_acct + wi_amt)) W.space <>
-			write_amount amt
-		 ) W.empty amts) <>
-	(case cmts of
-	 []  -> W.empty
-	 [c] -> W.space <> write_comment c
-	 _   -> W.line  <> write_comments (W.text "   ") cmts)
-
--- ** Type 'Widths_Posting'
-type Widths_Posting = Int
-
-widths_postings
- :: Context_Write
- -> Postings
- -> Widths_Posting
-widths_postings ctx (Postings ps) =
-	foldr (\p -> max $
-		((case posting_account_ref p of
-			 S.Just (a S.:!: sa) | context_write_account_ref ctx ->
-				width_account_ref a +
-				S.maybe 0 width_account sa
-			 _ -> width_account (posting_account p)
-		 ) +) $
-		(\len -> if len > 0 then 1 + len else len) $
-		Map.foldrWithKey
-		 (\unit qty -> max $
-			width_amount $
-			styled_amount (context_write_amounts ctx) $
-			Amount unit qty)
-		 0 (unAmounts $ posting_amounts p)
-	 ) 0
-	 (Compose ps)
-
--- * Write 'Transaction'
-write_transaction
- :: Context_Write
- -> Transaction -> Doc
-write_transaction ctx
- t@Transaction
- { transaction_comments
- , transaction_dates
- , transaction_wording  = Wording transaction_wording
- , transaction_postings = Postings transaction_postings
- , transaction_tags     = Transaction_Tags (Tags tags)
- } =
-	let ctx' = ctx { context_write_max_posting_width =
-		let wi = context_write_max_posting_width ctx in
-		if wi == 0
-		then widths_transaction ctx t
-		else wi } in
-	W.hcat (
-		List.intersperse
-		 (W.char char_transaction_date_sep)
-		 (write_date <$> NonNull.toNullable transaction_dates)) <>
-	(case transaction_wording of
-	 "" -> W.empty
-	 _  -> W.space <> W.dullmagenta (W.strict_text transaction_wording)) <>
-	W.line <>
-	(case transaction_comments of
-	 [] -> W.empty
-	 _  -> write_comments W.space transaction_comments <> W.line) <>
-	TreeMap.foldr_with_Path
-	 (\path -> flip $
-		foldr (\value -> (<>) (W.string "  " <>
-		write_transaction_tag (Transaction_Tag (Tag (Tag_Path path) value)) <> W.line)))
-	 W.empty tags <>
-	W.intercalate W.line
-	 (W.vsep . (write_posting ctx' <$>))
-	 transaction_postings
-
-write_transactions
- :: Foldable j
- => Context_Write
- -> j Transaction -> Doc
-write_transactions ctx j =
-	let ctx' = ctx{context_write_max_posting_width =
-		foldr (max . widths_transaction ctx) 0 j} in
-	foldr (\t doc ->
-		write_transaction ctx' t <>
-		(if W.is_empty doc then W.line else W.line <> W.line <> doc)
-	 ) W.empty j
-
--- ** Type 'Widths_Transaction'
-type Widths_Transaction = Widths_Posting
-
-widths_transaction :: Context_Write -> Transaction -> Widths_Posting
-widths_transaction ctx
- Transaction
- { transaction_postings
- } =
-	foldr
-	 (max . widths_postings ctx)
-	 0 [ transaction_postings ]
-
--- ** Write 'Transaction_Tag'
-write_transaction_tag :: Transaction_Tag -> Doc
-write_transaction_tag (Transaction_Tag (Tag (Tag_Path path) (Tag_Data value))) =
-	W.hcat (
-		(:) (W.bold $ W.dullyellow $ W.char char_tag_prefix) $
-		List.intersperse
-		 (op $ W.char char_tag_sep)
-		 (write_transaction_tag_section <$> NonNull.toNullable path)) <>
-	if Text.null value
-	then W.empty
-	else
-		op (W.char char_tag_data_prefix) <>
-		W.strict_text value
-	where
-	op = W.bold . W.yellow
-
-write_transaction_tag_section :: Name -> Doc
-write_transaction_tag_section = W.bold . W.strict_text . unName
-
--- * Write 'Journal'
-write_journal :: Foldable j => Context_Write -> Journal (j [Transaction]) -> Doc
-write_journal ctx jnl =
-	write_transactions ctx $
-	Compose $ journal_content jnl
-
--- * Write 'Journals'
-write_journals :: Foldable j => Context_Write -> Journals (j [Transaction]) -> Doc
-write_journals ctx (Journals js) =
-	Map.foldl
-	 (\doc j@Journal{journal_file=PathFile jf, journal_content=jc} ->
-		doc <>
-		write_comment (Comment $ Text.pack jf) <> W.line <>
-		if null jc then W.empty else (W.line <> write_journal ctx j)
-	 ) W.empty js
-
--- * Write 'Chart'
-write_chart :: Chart -> Doc
-write_chart =
-	TreeMap.foldl_with_Path
-	 (\doc acct (Account_Tags (Tags ca)) ->
-		doc <>
-		write_account (H.get acct) <> W.line <>
-		TreeMap.foldl_with_Path
-		 (\dd tp tvs ->
-			dd <>
-			foldl'
-			 (\ddd tv ->
-				ddd <> W.string "  " <>
-				write_account_tag (Account_Tag (Tag (Tag_Path tp) tv)) <>
-				W.line)
-			 W.empty
-			 tvs)
-		 W.empty
-		 ca
-	 ) W.empty .
-	chart_accounts
-
--- * Write 'Terms'
-
-write_terms :: Terms -> Doc
-write_terms ts =
-	Map.foldl
-	 (\doc t ->
-		doc <>
-		W.strict_text t <>
-		W.line
-	 ) W.empty ts
-
--- * Write 'Compta'
-write_compta :: Context_Write -> Compta src ss -> Doc
-write_compta ctx Compta
- { compta_journals=js
- , compta_chart=c@Chart{chart_accounts=ca}
- , compta_style_amounts=amts
- , compta_terms=ts
- } =
-	(if null ts then W.empty else (write_terms ts <> W.line)) <>
-	(if TreeMap.null ca then W.empty else (write_chart c <> W.line)) <>
-	write_journals ctx{context_write_amounts=context_write_amounts ctx <> amts} js
-
--- * Write 'SourcePos'
-write_sourcepos :: SourcePos -> IO Doc
-write_sourcepos (SourcePos p (PosFile l) (PosFile c)) = do
-	content <- Enc.decodeUtf8 <$> BS.readFile p
-	let ls = Text.lines content
-	let ll = max 1 $ l - size_ctx
-	let qs =
-		List.take (intFrom $ (l - ll) + 1 + size_ctx) $
-		List.drop (intFrom $ ll-1) ls
-	let ns = show <$> List.take (List.length qs) [ll..]
-	let max_len_n = maximum $ List.length <$> ns
-	let ns' = (<$> ns) $ \n ->
-		List.replicate (max_len_n - List.length n) ' ' <> n
-	let quote =
-		W.vcat $
-		List.zipWith (\(n, sn) q ->
-			"  " <> gray (W.strict_text (Text.pack sn)) <>
-			"  " <> (if n == l then mark q else W.strict_text q)
-		 ) (List.zip [ll..] ns') qs
-	return $ quote <> W.line
-	where
-	size_ctx = 2
-	intFrom = fromInteger . toInteger
-	mark q =
-		let (b, a) = Text.splitAt (intFrom c - 1) q in
-		W.strict_text b <>
-		case Text.uncons a of
-		 Nothing -> red " "
-		 Just (a0, a') -> red (W.char a0) <> W.strict_text a'
-
-gray :: Doc -> Doc
-gray = W.bold . W.dullblack
-
-red :: Doc -> Doc
-red = W.onred
-
-
--- Type 'Context_Write'
-data Context_Write
- =   Context_Write
- {   context_write_account_ref       :: Bool
- ,   context_write_amounts           :: Style_Amounts
- ,   context_write_max_posting_width :: Int
- }
-
-context_write :: Context_Write
-context_write =
-	Context_Write
-	 { context_write_account_ref       = True
-	 , context_write_amounts           = Style_Amounts Map.empty
-	 , context_write_max_posting_width = 0
-	 }
-
-{-
-type Style_Anchor = Bool
-type instance MC.CanDo (S.ReaderT Context_Write m) (MC.EffReader Context_Write) = 'True
-instance Monad m => MC.MonadReaderN 'MC.Zero Context_Write (S.ReaderT Context_Write m) where
-	askN _px = S.ReaderT R.ask
-type instance MC.CanDo (S.ReaderT Context_Write m) (MC.EffReader Style_Anchor) = 'True
-instance Monad m => MC.MonadReaderN 'MC.Zero Style_Anchor (S.ReaderT Context_Write m) where
-	askN _px = S.ReaderT $ R.asks $ Style_Anchor . context_write_account_ref
--}
-
--- * Type 'Style_Write'
-data Style_Write
- =   Style_Write
- {   style_write_align :: Bool
- ,   style_write_color :: Bool
- }
-style_write :: Style_Write
-style_write =
-	Style_Write
-	 { style_write_align = True
-	 , style_write_color = True
-	 }
-
--- * Write
-write :: Style_Write -> Doc -> TL.Text
-write Style_Write
- { style_write_color
- , style_write_align } =
-	W.displayT .
-	if style_write_align
-	then W.renderPretty  style_write_color 1.0 maxBound
-	else W.renderCompact style_write_color
-
-writeIO :: Style_Write -> Handle -> Doc -> IO ()
-writeIO Style_Write
- { style_write_color
- , style_write_align
- } handle doc =
-	W.displayIO handle $
-	if style_write_align
-	then W.renderPretty  style_write_color 1.0 maxBound doc
-	else W.renderCompact style_write_color doc
diff --git a/lcc/hcompta-lcc.cabal b/lcc/hcompta-lcc.cabal
index bff7e75..f3eb693 100644
--- a/lcc/hcompta-lcc.cabal
+++ b/lcc/hcompta-lcc.cabal
@@ -82,6 +82,7 @@ Library
     Hcompta.LCC.Amount
     Hcompta.LCC.Chart
     Hcompta.LCC.Compta
+    Hcompta.LCC.Document
     Hcompta.LCC.Grammar
     Hcompta.LCC.Journal
     Hcompta.LCC.Lib.FilePath
@@ -106,7 +107,6 @@ Library
     Hcompta.LCC.Sym.Zipper
     Hcompta.LCC.Tag
     Hcompta.LCC.Transaction
-    Hcompta.LCC.Write
   build-depends:
     base >= 4.6 && < 5
     , ansi-terminal >= 0.4 && < 0.7
@@ -119,13 +119,13 @@ Library
     , directory
     , filepath
     , hcompta-lib
-    , integer-gmp
     , mono-traversable
     , monad-classes
     , megaparsec
     , safe-exceptions
     , strict
     , symantic
+    , symantic-document
     , symantic-grammar
     , symantic-lib
     , text
@@ -133,7 +133,6 @@ Library
     , transformers >= 0.4 && < 0.6
                    -- NOTE: needed for Control.Monad.Trans.Except
     , treemap
-    , walderleijen-ansi-text
     , unix
     -- , fingertree
     -- , parsec >= 3.1.2 && < 4
@@ -155,6 +154,7 @@ Executable eval
     LambdaCase
     MultiParamTypeClasses
     NamedFieldPuns
+    NoImplicitPrelude
     OverloadedStrings
     PatternGuards
     PolyKinds
@@ -197,17 +197,16 @@ Executable eval
     , safe-exceptions
     , semigroups
     , symantic
+    , symantic-document
     , symantic-lib
     , symantic-grammar
     , strict
-    , symantic
     -- , template-haskell
     , text
     , time
     , transformers >= 0.4 && < 0.6
                    -- NOTE: needed for Control.Monad.Trans.Except
     , treemap
-    , walderleijen-ansi-text
 
 Executable load
   extensions:
@@ -220,6 +219,7 @@ Executable load
     LambdaCase
     MultiParamTypeClasses
     NamedFieldPuns
+    NoImplicitPrelude
     OverloadedStrings
     PatternGuards
     PolyKinds
@@ -262,17 +262,16 @@ Executable load
     , safe-exceptions
     , semigroups
     , symantic
+    , symantic-document
     , symantic-lib
     , symantic-grammar
     , strict
-    , symantic
     -- , template-haskell
     , text
     , time
     , transformers >= 0.4 && < 0.6
                    -- NOTE: needed for Control.Monad.Trans.Except
     , treemap
-    , walderleijen-ansi-text
 
 -- Test-Suite hcompta-cli-test
 --   type: exitcode-stdio-1.0
@@ -358,6 +357,7 @@ Executable load
 --     , semigroups
 --     , strict
 --     , symantic
+--     , symantic-document
 --     , symantic-grammar
 --     , symantic-lib
 --     , tasty >= 0.11
@@ -366,4 +366,3 @@ Executable load
 --     , time
 --     , transformers >= 0.4 && < 0.6
 --     , treemap
---     , walderleijen-ansi-text
diff --git a/lcc/stack.yaml b/lcc/stack.yaml
index 2b50f52..4fdefe8 100644
--- a/lcc/stack.yaml
+++ b/lcc/stack.yaml
@@ -7,6 +7,8 @@ packages:
   extra-dep: true
 - location: '/home/julm/work/pad/informatique/symantic/6/symantic'
   extra-dep: true
+- location: '/home/julm/work/pad/informatique/symantic/6/symantic-document'
+  extra-dep: true
 - location: '/home/julm/work/pad/informatique/symantic/6/symantic-grammar'
   extra-dep: true
 - location: '/home/julm/work/pad/informatique/symantic/6/symantic-lib'
-- 
2.47.2