From 7f915bb77f29b5339c2f94b84b7cb4a7e5f6574b Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+hcompta@autogeree.net>
Date: Wed, 12 Jul 2017 15:27:04 +0200
Subject: [PATCH] Gather into Writeable instances.

---
 lcc/Hcompta/LCC.hs                            |   6 +-
 lcc/Hcompta/LCC/Balance.hs                    |  44 +-
 lcc/Hcompta/LCC/Document.hs                   | 432 -----------------
 lcc/Hcompta/LCC/Eval.hs                       |   2 +-
 lcc/Hcompta/LCC/Load.hs                       |   5 +-
 lcc/Hcompta/LCC/Read.hs                       |  10 +-
 .../LCC/{Grammar.hs => Read/Compta.hs}        |   2 +-
 lcc/Hcompta/LCC/{ => Read}/Megaparsec.hs      |  12 +-
 lcc/Hcompta/LCC/Sym/Account.hs                |   8 +-
 lcc/Hcompta/LCC/Sym/Addable.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Amount.hs                 |   4 +-
 lcc/Hcompta/LCC/Sym/Balance.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Chart.hs                  |   4 +-
 lcc/Hcompta/LCC/Sym/Compta.hs                 |   4 +-
 lcc/Hcompta/LCC/Sym/Date.hs                   |   2 +-
 lcc/Hcompta/LCC/Sym/FileSystem.hs             |   4 +-
 lcc/Hcompta/LCC/Sym/Journal.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Negable.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Posting.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Quantity.hs               |   6 +-
 lcc/Hcompta/LCC/Sym/Subable.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Sumable.hs                |   4 +-
 lcc/Hcompta/LCC/Sym/Transaction.hs            |   4 +-
 lcc/Hcompta/LCC/Sym/Unit.hs                   |   4 +-
 lcc/Hcompta/LCC/Sym/Zeroable.hs               |   4 +-
 lcc/Hcompta/LCC/Sym/Zipper.hs                 |   4 +-
 lcc/Hcompta/LCC/Write.hs                      |   5 +
 lcc/Hcompta/LCC/Write/Compta.hs               | 433 ++++++++++++++++++
 lcc/hcompta-lcc.cabal                         |   8 +-
 29 files changed, 515 insertions(+), 520 deletions(-)
 delete mode 100644 lcc/Hcompta/LCC/Document.hs
 rename lcc/Hcompta/LCC/{Grammar.hs => Read/Compta.hs} (99%)
 rename lcc/Hcompta/LCC/{ => Read}/Megaparsec.hs (98%)
 create mode 100644 lcc/Hcompta/LCC/Write.hs
 create mode 100644 lcc/Hcompta/LCC/Write/Compta.hs

diff --git a/lcc/Hcompta/LCC.hs b/lcc/Hcompta/LCC.hs
index 969be50..3d99b7c 100644
--- a/lcc/Hcompta/LCC.hs
+++ b/lcc/Hcompta/LCC.hs
@@ -3,8 +3,6 @@ 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
  , module Hcompta.LCC.Posting
@@ -12,14 +10,13 @@ module Hcompta.LCC
  , module Hcompta.LCC.Source
  , 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
 import Hcompta.LCC.Posting
@@ -27,3 +24,4 @@ import Hcompta.LCC.Read
 import Hcompta.LCC.Source
 import Hcompta.LCC.Tag
 import Hcompta.LCC.Transaction
+import Hcompta.LCC.Write
diff --git a/lcc/Hcompta/LCC/Balance.hs b/lcc/Hcompta/LCC/Balance.hs
index 990f85a..1bde32f 100644
--- a/lcc/Hcompta/LCC/Balance.hs
+++ b/lcc/Hcompta/LCC/Balance.hs
@@ -1,10 +1,22 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Hcompta.LCC.Balance where
 
-import Data.Function (flip)
+import Data.Ord (Ord)
+import Data.Bool (Bool(..))
+import Data.Maybe (Maybe(..))
+import Data.Function (($), flip)
 import Data.Functor ((<$>))
 import Data.Map.Strict (Map)
 -- import Data.Foldable (Foldable(..))
+-- import Data.Functor.Compose
+-- import Data.Function ((.))
+import qualified Data.List as L
+import qualified Data.MonoTraversable as MT
+import qualified Data.TreeMap.Strict as TM
+import qualified Data.Map.Strict as Map
+
+import qualified Language.Symantic.Document as D
 
 import qualified Hcompta as H
 
@@ -14,13 +26,9 @@ import Hcompta.LCC.Posting
 import Hcompta.LCC.Transaction
 import Hcompta.LCC.Journal
 import Hcompta.LCC.Compta
-{-
-import Data.Functor.Compose
-import Data.Function ((.))
 
--}
-import qualified Data.MonoTraversable as MT
 
+-- * Type 'Balance'
 type Balance         = H.Balance         NameAccount Unit (H.Polarized Quantity)
 type BalByAccount    = H.BalByAccount    NameAccount Unit (H.Polarized Quantity)
 type BalByUnit       = H.BalByUnit       NameAccount Unit (H.Polarized Quantity)
@@ -43,30 +51,8 @@ instance H.Sumable Balance a => H.Sumable Balance (Compta src ss a) where
 instance H.Sumable Balance (Map Date [Transaction]) where
 	bal += m = MT.ofoldr (flip (H.+=)) bal m
 
+-- * Class 'Balanceable'
 type Balanceable = H.Sumable Balance
 balance :: Balanceable a => a -> Balance
 balance = H.sum
 
-{-
-consBal :: Posting -> Balance -> Balance
-consBal = H.consBal
-
--- type instance H.Postings H.:@ Transaction = Postings
--- instance H.Get (H.Balance_Amounts Unit Quantity) [Transaction] where
--- 	get = transaction_postings
-
-balancePosting :: Posting -> Balance -> Balance
-balancePosting = H.consBal
-balanceTransaction :: Transaction -> Balance -> Balance
-balanceTransaction = H.balance . transaction_postings
-balancePostings :: Postings -> Balance -> Balance
-balancePostings = H.balance
-balanceTransactions :: [Transaction] -> Balance -> Balance
-balanceTransactions = flip $ foldr H.balance
-
-balance :: Journal [Transaction] -> Balance -> Balance
-balance = flip $ MT.ofoldr $ flip $ foldr H.balance
-
--- (Get (Balance_Account acct_sect) post, Get (Balance_Amounts unit qty) post, Addable qty, Ord acct_sect, Ord unit) => post -> Balance acct_sect unit qty -> Balance acct_sect unit qty
--- balance_postings :: (post ~ Element posts, MonoFoldable posts, Get (Balance_Account acct_sect) post, Get (Balance_Amounts unit qty) post, Addable qty, Ord acct_sect, Ord unit) => posts -> Balance acct_sect unit qty -> Balance acct_sect unit qty 
---}
diff --git a/lcc/Hcompta/LCC/Document.hs b/lcc/Hcompta/LCC/Document.hs
deleted file mode 100644
index f6e9d54..0000000
--- a/lcc/Hcompta/LCC/Document.hs
+++ /dev/null
@@ -1,432 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module Hcompta.LCC.Document where
-
-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(..), fromMaybe)
-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.Compta
-import Hcompta.LCC.IO
-import Hcompta.LCC.Journal
-import Hcompta.LCC.Name
-import Hcompta.LCC.Posting
-import Hcompta.LCC.Tag
-import Hcompta.LCC.Transaction
-import qualified Hcompta.LCC.Grammar as G
-
--- 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.gregorianOf dat in
-	(if y == 0 then D.empty else D.integer y <> sep G.char_ymd_sep) <>
-	int2 mo <>
-	sep G.char_ymd_sep <> int2 d <>
-	(case H.todOf 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 G.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 G.char_account_tag_prefix) $
-		List.intersperse
-		 (op $ D.charH G.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 G.char_account_tag_prefix) $
-		List.intersperse
-		 (op $ D.charH G.char_tag_sep)
-		 (D.textH . unName <$> NonNull.toNullable path) ) <>
-	if Text.null value
-	then D.empty
-	else
-		op (D.charH G.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 | not (H.null u) -> D.space
-		 _ -> D.empty
-	 _ -> D.empty
-	<> d_quantity (sty, q)
-	<> case uside of
-	 S.Just R ->
-		(case uspaced of
-		 S.Just True | not (H.null u) -> D.space
-		 _ -> D.empty) <>
-		d_unit u
-	 S.Nothing ->
-		(case uspaced of
-		 S.Just True | not (H.null u) -> D.space
-		 _ -> D.empty) <>
-		d_unit u
-	 _ -> D.empty
-w_amount = D.width . D.dim . d_amount
-
--- * Document 'Unit'
-d_unit (Unit t) =
-	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 G.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 ->
-		fromMaybe D.empty $
-		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 G.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
-	fromMaybe D.empty $
-	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 G.char_tag_prefix) $
-		List.intersperse
-		 (op $ D.charH G.char_tag_sep)
-		 (d_transaction_tag_section <$> NonNull.toNullable path)) <>
-	if Text.null value
-	then D.empty
-	else op (D.charH G.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.to 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/Eval.hs b/lcc/Hcompta/LCC/Eval.hs
index 617a002..af4d1e3 100644
--- a/lcc/Hcompta/LCC/Eval.hs
+++ b/lcc/Hcompta/LCC/Eval.hs
@@ -38,7 +38,7 @@ import qualified Language.Symantic.Lib as Sym
 
 import qualified Hcompta.LCC.Sym as LCC.Sym
 -- import qualified Hcompta.LCC as LCC
-import Hcompta.LCC.Megaparsec ()
+import Hcompta.LCC.Read ()
 
 -- dbg :: Show a => String -> a -> a
 -- dbg msg x = trace (msg ++ " = " ++ show x) x
diff --git a/lcc/Hcompta/LCC/Load.hs b/lcc/Hcompta/LCC/Load.hs
index a9ae1ed..040ae73 100644
--- a/lcc/Hcompta/LCC/Load.hs
+++ b/lcc/Hcompta/LCC/Load.hs
@@ -18,10 +18,9 @@ import qualified Language.Symantic.Document as Doc
 import qualified Language.Symantic as Sym
 
 import qualified Hcompta.LCC.Sym as LCC.Sym
-import Hcompta.LCC.Megaparsec (showParseError)
 import Hcompta.LCC.Posting (SourcePos)
 import Hcompta.LCC.Read
-import Hcompta.LCC.Document
+import Hcompta.LCC.Write
 import Hcompta.LCC.Compta
 import Hcompta.LCC.Source
 import Hcompta.LCC.Sym.Compta ()
@@ -43,7 +42,7 @@ main = do
 			print warns
 			-- print r
 			(`Doc.ansiIO` stdout) $
-				d_compta context_write r
+				write (context_write, r)
 
 printError :: Show err => Either err a -> IO a
 printError (Left err) = error $ show err
diff --git a/lcc/Hcompta/LCC/Read.hs b/lcc/Hcompta/LCC/Read.hs
index c47ac69..4f2ed36 100644
--- a/lcc/Hcompta/LCC/Read.hs
+++ b/lcc/Hcompta/LCC/Read.hs
@@ -6,7 +6,11 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Hcompta.LCC.Read where
+module Hcompta.LCC.Read
+ ( module Hcompta.LCC.Read
+ , module Hcompta.LCC.Read.Compta
+ , module Hcompta.LCC.Read.Megaparsec
+ ) where
 
 import Control.Applicative (Applicative(..), (<*))
 import Control.Monad (Monad(..))
@@ -43,8 +47,8 @@ import Hcompta.LCC.Transaction
 import Hcompta.LCC.IO
 -- import Hcompta.LCC.Sym.Compta ()
 
-import Hcompta.LCC.Grammar
-import Hcompta.LCC.Megaparsec ()
+import Hcompta.LCC.Read.Compta
+import Hcompta.LCC.Read.Megaparsec
 import qualified Hcompta.LCC.Lib.Strict as S
 import qualified Hcompta as H
 
diff --git a/lcc/Hcompta/LCC/Grammar.hs b/lcc/Hcompta/LCC/Read/Compta.hs
similarity index 99%
rename from lcc/Hcompta/LCC/Grammar.hs
rename to lcc/Hcompta/LCC/Read/Compta.hs
index 6a7f45a..73e2164 100644
--- a/lcc/Hcompta/LCC/Grammar.hs
+++ b/lcc/Hcompta/LCC/Read/Compta.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
-module Hcompta.LCC.Grammar where
+module Hcompta.LCC.Read.Compta where
 
 import Control.Applicative (Applicative(..), liftA2)
 import Control.Monad (Monad(..), void)
diff --git a/lcc/Hcompta/LCC/Megaparsec.hs b/lcc/Hcompta/LCC/Read/Megaparsec.hs
similarity index 98%
rename from lcc/Hcompta/LCC/Megaparsec.hs
rename to lcc/Hcompta/LCC/Read/Megaparsec.hs
index 94d08ad..06dbb06 100644
--- a/lcc/Hcompta/LCC/Megaparsec.hs
+++ b/lcc/Hcompta/LCC/Read/Megaparsec.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- | Symantic and LCC grammar instances for Megaparsec
-module Hcompta.LCC.Megaparsec where
+module Hcompta.LCC.Read.Megaparsec where
 
 import Control.Applicative (Applicative(..))
 import Control.Monad (Monad(..))
@@ -17,7 +17,6 @@ import Data.Int (Int)
 import Data.List ((++))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (Maybe(..))
-import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Set (Set)
 import Data.String (IsString(..), String)
@@ -49,14 +48,15 @@ import qualified Language.Symantic.Document as D
 import Hcompta.LCC.Amount
 import Hcompta.LCC.Chart
 import Hcompta.LCC.Compta
-import Hcompta.LCC.Document
-import Hcompta.LCC.Grammar as LCC
+import Hcompta.LCC.Write
+import Hcompta.LCC.Read.Compta as LCC
 import Hcompta.LCC.IO
-import Hcompta.LCC.Journal
+-- import Hcompta.LCC.Journal
 import Hcompta.LCC.Posting
 
 import Debug.Trace (trace)
 import Data.Semigroup ((<>))
+
 dbg :: Show a => [Char] -> a -> a
 dbg msg x = trace (msg <> " = " <> show x) x
 
@@ -400,7 +400,7 @@ showParseError ::
  ) => P.ParseError t e -> IO d
 showParseError err = do
 	let (pos:|_) = P.errorPos err
-	q <- d_sourcepos $ sourcePos pos
+	q <- write $ sourcePos pos
 	return $ D.catV
 	 [ D.stringH (sourcePosStackPretty $ P.errorPos err) <> ":"
 	 , D.stringH $ parseErrorTextPretty err
diff --git a/lcc/Hcompta/LCC/Sym/Account.hs b/lcc/Hcompta/LCC/Sym/Account.hs
index 6d81fec..c28df8c 100644
--- a/lcc/Hcompta/LCC/Sym/Account.hs
+++ b/lcc/Hcompta/LCC/Sym/Account.hs
@@ -37,7 +37,7 @@ instance (Sym_Account r1, Sym_Account r2) => Sym_Account (Dup r1 r2) where
 instance (Sym_Account term, Sym_Lambda term) => Sym_Account (BetaT term)
 
 instance NameTyOf Account where
-	nameTyOf _c = ["LCC"] `Mod` "Account"
+	nameTyOf _c = ["Account"] `Mod` "Account"
 instance ClassInstancesFor Account where
 	proveConstraintFor _c (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Account) @Account c
@@ -75,7 +75,7 @@ instance -- Gram_Term_AtomsFor
 			Name . Text.pack
 			 <$> some (choice $ unicat <$> [Unicat_Letter])
 instance (Source src, SymInj ss Account) => ModuleFor src ss Account where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Account"] `moduleWhere`
 	 [
 	 ]
 
@@ -94,7 +94,7 @@ instance Sym_Name View where
 instance (Sym_Name r1, Sym_Name r2) => Sym_Name (Dup r1 r2) where
 
 instance NameTyOf Name where
-	nameTyOf _c = ["LCC"] `Mod` "Name"
+	nameTyOf _c = ["Name"] `Mod` "Name"
 instance ClassInstancesFor Name where
 	proveConstraintFor _c (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Name) @Name c
@@ -111,6 +111,6 @@ instance TypeInstancesFor Name where
 	expandFamFor _c _len _fam _as = Nothing
 instance Gram_Term_AtomsFor src ss g Name
 instance (Source src, SymInj ss Name) => ModuleFor src ss Name where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Name"] `moduleWhere`
 	 [
 	 ]
diff --git a/lcc/Hcompta/LCC/Sym/Addable.hs b/lcc/Hcompta/LCC/Sym/Addable.hs
index bf40148..069707a 100644
--- a/lcc/Hcompta/LCC/Sym/Addable.hs
+++ b/lcc/Hcompta/LCC/Sym/Addable.hs
@@ -25,13 +25,13 @@ instance (Sym_Addable r1, Sym_Addable r2) => Sym_Addable (Dup r1 r2) where
 instance (Sym_Addable term, Sym_Lambda term) => Sym_Addable (BetaT term)
 
 instance NameTyOf Addable where
-	nameTyOf _c = ["LCC"] `Mod` "Addable"
+	nameTyOf _c = ["Addable"] `Mod` "Addable"
 instance FixityOf Addable
 instance ClassInstancesFor Addable
 instance TypeInstancesFor Addable
 instance Gram_Term_AtomsFor src ss g Addable
 instance (Source src, SymInj ss Addable) => ModuleFor src ss Addable where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Addable"] `moduleWhere`
 	 [ "+" `withInfixB` (SideL, 6) := teAddable_add
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Amount.hs b/lcc/Hcompta/LCC/Sym/Amount.hs
index 44bf6f8..51b3e4e 100644
--- a/lcc/Hcompta/LCC/Sym/Amount.hs
+++ b/lcc/Hcompta/LCC/Sym/Amount.hs
@@ -48,7 +48,7 @@ instance (Sym_Amounts r1, Sym_Amounts r2) => Sym_Amounts (Dup r1 r2) where
 instance (Sym_Amounts term, Sym_Lambda term) => Sym_Amounts (BetaT term)
 
 instance NameTyOf Amounts where
-	nameTyOf _c = ["LCC"] `Mod` "Amounts"
+	nameTyOf _c = ["Amount"] `Mod` "Amounts"
 instance ClassInstancesFor Amounts where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Amounts) @Amounts c
@@ -64,7 +64,7 @@ instance TypeInstancesFor Amounts
 
 instance Gram_Term_AtomsFor meta ss g Amounts
 instance (Source src, SymInj ss Amounts, SymInj ss Unit) => ModuleFor src ss Amounts where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Amount"] `moduleWhere`
 	 [ NameTe n  `WithFixity` Fixity1 (mkFixy side 10) := mkAmount nega u
 	 | (u, style_amount_unit_side -> S.Just side) <-
 		Map.toList $
diff --git a/lcc/Hcompta/LCC/Sym/Balance.hs b/lcc/Hcompta/LCC/Sym/Balance.hs
index 6c32837..767dd4c 100644
--- a/lcc/Hcompta/LCC/Sym/Balance.hs
+++ b/lcc/Hcompta/LCC/Sym/Balance.hs
@@ -30,7 +30,7 @@ instance (Sym_Balance r1, Sym_Balance r2) => Sym_Balance (Dup r1 r2) where
 instance (Sym_Balance term, Sym_Lambda term) => Sym_Balance (BetaT term)
 
 instance NameTyOf Balance where
-	nameTyOf _c = ["LCC"] `Mod` "Balance"
+	nameTyOf _c = ["Balance"] `Mod` "Balance"
 -- instance FixityOf Balance
 instance ClassInstancesFor Balance where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) b)
@@ -42,7 +42,7 @@ instance ClassInstancesFor Balance where
 instance TypeInstancesFor Balance
 instance Gram_Term_AtomsFor src ss g Balance
 instance (Source src, SymInj ss Balance) => ModuleFor src ss Balance where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Balance"] `moduleWhere`
 	 [ "balance" := teBalance_balance
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Chart.hs b/lcc/Hcompta/LCC/Sym/Chart.hs
index 8f706a4..7372343 100644
--- a/lcc/Hcompta/LCC/Sym/Chart.hs
+++ b/lcc/Hcompta/LCC/Sym/Chart.hs
@@ -28,7 +28,7 @@ instance (Sym_Chart r1, Sym_Chart r2) => Sym_Chart (Dup r1 r2) where
 instance (Sym_Chart term, Sym_Lambda term) => Sym_Chart (BetaT term)
 
 instance NameTyOf Chart where
-	nameTyOf _c = ["LCC"] `Mod` "Chart"
+	nameTyOf _c = ["Chart"] `Mod` "Chart"
 instance ClassInstancesFor Chart where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) a)
 	 | Just HRefl <- proj_ConstKiTy @(K Chart) @Chart a
@@ -41,7 +41,7 @@ instance TypeInstancesFor Chart where
 
 instance Gram_Term_AtomsFor src ss g Chart
 instance (Source src, SymInj ss Chart) => ModuleFor src ss Chart where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Chart"] `moduleWhere`
 	 [
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Compta.hs b/lcc/Hcompta/LCC/Sym/Compta.hs
index 7def199..ba0d4e8 100644
--- a/lcc/Hcompta/LCC/Sym/Compta.hs
+++ b/lcc/Hcompta/LCC/Sym/Compta.hs
@@ -55,7 +55,7 @@ instance (Sym_Compta r1, Sym_Compta r2) => Sym_Compta (Dup r1 r2) where
 instance (Sym_Compta term, Sym_Lambda term) => Sym_Compta (BetaT term)
 
 instance (Typeable src, Typeable ss) => NameTyOf (Compta src ss) where
-	nameTyOf _c = ["LCC"] `Mod` "Compta"
+	nameTyOf _c = ["Compta"] `Mod` "Compta"
 instance FixityOf (Compta src ss)
 instance Comptable src ss =>
          ClassInstancesFor (Compta src ss) where
@@ -98,7 +98,7 @@ instance
  , Comptable src ss
  , SymInj           (Proxy (Compta src ss) ': ss) (Compta src ss)
  ) => ModuleFor src (Proxy (Compta src ss) ': ss) (Compta src ss) where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Compta"] `moduleWhere`
 	 [ "chart" := teCompta_chart
 	 , "readCompta" := teCompta_readCompta
 	 ]
diff --git a/lcc/Hcompta/LCC/Sym/Date.hs b/lcc/Hcompta/LCC/Sym/Date.hs
index 20e6320..0fd165b 100644
--- a/lcc/Hcompta/LCC/Sym/Date.hs
+++ b/lcc/Hcompta/LCC/Sym/Date.hs
@@ -21,7 +21,7 @@ instance (Sym_Date r1, Sym_Date r2) => Sym_Date (Dup r1 r2) where
 instance (Sym_Date term, Sym_Lambda term) => Sym_Date (BetaT term)
 
 instance NameTyOf Date where
-	nameTyOf _c = ["LCC"] `Mod` "Date"
+	nameTyOf _c = ["Date"] `Mod` "Date"
 instance ClassInstancesFor Date where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) a)
 	 | Just HRefl <- proj_ConstKiTy @(K Date) @Date a
diff --git a/lcc/Hcompta/LCC/Sym/FileSystem.hs b/lcc/Hcompta/LCC/Sym/FileSystem.hs
index fec6479..7b86838 100644
--- a/lcc/Hcompta/LCC/Sym/FileSystem.hs
+++ b/lcc/Hcompta/LCC/Sym/FileSystem.hs
@@ -36,7 +36,7 @@ instance (Sym_PathFile r1, Sym_PathFile r2) => Sym_PathFile (Dup r1 r2) where
 instance (Sym_PathFile term, Sym_Lambda term) => Sym_PathFile (BetaT term)
 
 instance NameTyOf PathFile where
-	nameTyOf _c = ["LCC"] `Mod` "PathFile"
+	nameTyOf _c = ["FS"] `Mod` "PathFile"
 instance ClassInstancesFor PathFile where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K PathFile) @PathFile c
@@ -70,7 +70,7 @@ instance -- Gram_Term_AtomsFor
 		g_pathfile_section :: CF g FilePath
 		g_pathfile_section = some (choice $ char '.' : (unicat <$> [Unicat_Letter, Unicat_Number]))
 instance (Source src, SymInj ss PathFile) => ModuleFor src ss PathFile where
-	moduleFor = ["LCC", "PathFile"] `moduleWhere`
+	moduleFor = ["FS", "PathFile"] `moduleWhere`
 	 [
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Journal.hs b/lcc/Hcompta/LCC/Sym/Journal.hs
index bb59d1d..beaf501 100644
--- a/lcc/Hcompta/LCC/Sym/Journal.hs
+++ b/lcc/Hcompta/LCC/Sym/Journal.hs
@@ -53,7 +53,7 @@ instance (Sym_Journal r1, Sym_Journal r2) => Sym_Journal (Dup r1 r2) where
 instance (Sym_Journal term, Sym_Lambda term) => Sym_Journal (BetaT term)
 
 instance NameTyOf Journal where
-	nameTyOf _c = ["LCC"] `Mod` "Journal"
+	nameTyOf _c = ["Journal"] `Mod` "Journal"
 instance FixityOf Journal
 instance ClassInstancesFor Journal where
 	proveConstraintFor _ (TyApp _ tq@(TyConst _ _ q) (TyApp _ c j))
@@ -69,7 +69,7 @@ instance TypeInstancesFor Journal
 
 instance Gram_Term_AtomsFor src ss g Journal
 instance (Source src, SymInj ss Journal) => ModuleFor src ss Journal where
-	moduleFor = ["LCC", "Journal"] `moduleWhere`
+	moduleFor = ["Journal"] `moduleWhere`
 	 [ "file"           := teJournal_file
 	 , "last_read_time" := teJournal_last_read_time
 	 , "content"        := teJournal_content
diff --git a/lcc/Hcompta/LCC/Sym/Negable.hs b/lcc/Hcompta/LCC/Sym/Negable.hs
index 4ced187..d14fc0b 100644
--- a/lcc/Hcompta/LCC/Sym/Negable.hs
+++ b/lcc/Hcompta/LCC/Sym/Negable.hs
@@ -25,13 +25,13 @@ instance (Sym_Negable r1, Sym_Negable r2) => Sym_Negable (Dup r1 r2) where
 instance (Sym_Negable term, Sym_Lambda term) => Sym_Negable (BetaT term)
 
 instance NameTyOf Negable where
-	nameTyOf _c = ["LCC"] `Mod` "Negable"
+	nameTyOf _c = ["Negable"] `Mod` "Negable"
 instance FixityOf Negable
 instance ClassInstancesFor Negable
 instance TypeInstancesFor Negable
 instance Gram_Term_AtomsFor src ss g Negable
 instance (Source src, SymInj ss Negable) => ModuleFor src ss Negable where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Negable"] `moduleWhere`
 	 [ "-" `withPrefix` 10 := teNegable_neg
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Posting.hs b/lcc/Hcompta/LCC/Sym/Posting.hs
index 5a89ec5..badeb60 100644
--- a/lcc/Hcompta/LCC/Sym/Posting.hs
+++ b/lcc/Hcompta/LCC/Sym/Posting.hs
@@ -40,7 +40,7 @@ instance (Sym_Posting r1, Sym_Posting r2) => Sym_Posting (Dup r1 r2) where
 instance (Sym_Posting term, Sym_Lambda term) => Sym_Posting (BetaT term)
 
 instance NameTyOf Posting where
-	nameTyOf _c = ["LCC"] `Mod` "Posting"
+	nameTyOf _c = ["Posting"] `Mod` "Posting"
 instance ClassInstancesFor Posting where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Posting) @Posting c
@@ -53,7 +53,7 @@ instance TypeInstancesFor Posting where
 
 instance Gram_Term_AtomsFor src ss g Posting
 instance (Source src, SymInj ss Posting) => ModuleFor src ss Posting where
-	moduleFor = ["LCC", "Posting"] `moduleWhere`
+	moduleFor = ["Posting"] `moduleWhere`
 	 [ "account" := tePosting_account
 	 , "amounts" := tePosting_amounts
 	 ]
diff --git a/lcc/Hcompta/LCC/Sym/Quantity.hs b/lcc/Hcompta/LCC/Sym/Quantity.hs
index 4cf5451..e31b51c 100644
--- a/lcc/Hcompta/LCC/Sym/Quantity.hs
+++ b/lcc/Hcompta/LCC/Sym/Quantity.hs
@@ -15,7 +15,7 @@ import qualified Data.Text as Text
 
 import Hcompta (Addable, Negable, Subable)
 import Hcompta.LCC.Amount
-import Hcompta.LCC.Grammar
+import Hcompta.LCC.Read.Compta
 
 import Language.Symantic.Grammar as Sym
 import Language.Symantic
@@ -37,7 +37,7 @@ instance (Sym_Quantity r1, Sym_Quantity r2) => Sym_Quantity (Dup r1 r2) where
 instance (Sym_Quantity term, Sym_Lambda term) => Sym_Quantity (BetaT term)
 
 instance NameTyOf Quantity where
-	nameTyOf _c = ["LCC"] `Mod` "Quantity"
+	nameTyOf _c = ["Quantity"] `Mod` "Quantity"
 instance ClassInstancesFor Quantity where
 	proveConstraintFor _c (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Quantity) @Quantity c
@@ -74,7 +74,7 @@ instance -- Gram_Term_AtomsFor
 		 -- <*> option [] ((:) <$> char '.' <*> some (choice $ char <$> ['0'..'9']))
 	 ]
 instance (Source src, SymInj ss Quantity) => ModuleFor src ss Quantity where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Quantity"] `moduleWhere`
 	 [
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Subable.hs b/lcc/Hcompta/LCC/Sym/Subable.hs
index c45a9a4..259d609 100644
--- a/lcc/Hcompta/LCC/Sym/Subable.hs
+++ b/lcc/Hcompta/LCC/Sym/Subable.hs
@@ -25,13 +25,13 @@ instance (Sym_Subable r1, Sym_Subable r2) => Sym_Subable (Dup r1 r2) where
 instance (Sym_Subable term, Sym_Lambda term) => Sym_Subable (BetaT term)
 
 instance NameTyOf Subable where
-	nameTyOf _c = ["LCC"] `Mod` "Subable"
+	nameTyOf _c = ["Subable"] `Mod` "Subable"
 instance FixityOf Subable
 instance ClassInstancesFor Subable
 instance TypeInstancesFor Subable
 instance Gram_Term_AtomsFor src ss g Subable
 instance (Source src, SymInj ss Subable) => ModuleFor src ss Subable where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Subable"] `moduleWhere`
 	 [ "-" `withInfixB` (SideL, 6) := teSubable_sub
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Sumable.hs b/lcc/Hcompta/LCC/Sym/Sumable.hs
index 9ddf3c6..a2afbbb 100644
--- a/lcc/Hcompta/LCC/Sym/Sumable.hs
+++ b/lcc/Hcompta/LCC/Sym/Sumable.hs
@@ -25,13 +25,13 @@ instance (Sym_Sumable r1, Sym_Sumable r2) => Sym_Sumable (Dup r1 r2) where
 instance (Sym_Sumable term, Sym_Lambda term) => Sym_Sumable (BetaT term)
 
 instance NameTyOf Sumable where
-	nameTyOf _c = ["LCC"] `Mod` "Sumable"
+	nameTyOf _c = ["Sumable"] `Mod` "Sumable"
 instance FixityOf Sumable
 instance ClassInstancesFor Sumable
 instance TypeInstancesFor Sumable
 instance Gram_Term_AtomsFor src ss g Sumable
 instance (Source src, SymInj ss Sumable) => ModuleFor src ss Sumable where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Sumable"] `moduleWhere`
 	 [ "+=" `withInfixN` 4 := teSumable_incBy
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Transaction.hs b/lcc/Hcompta/LCC/Sym/Transaction.hs
index 4093cd0..6524f6e 100644
--- a/lcc/Hcompta/LCC/Sym/Transaction.hs
+++ b/lcc/Hcompta/LCC/Sym/Transaction.hs
@@ -51,7 +51,7 @@ instance (Sym_Transaction r1, Sym_Transaction r2) => Sym_Transaction (Dup r1 r2)
 instance (Sym_Transaction term, Sym_Lambda term) => Sym_Transaction (BetaT term)
 
 instance NameTyOf Transaction where
-	nameTyOf _c = ["LCC"] `Mod` "Transaction"
+	nameTyOf _c = ["Transaction"] `Mod` "Transaction"
 instance ClassInstancesFor Transaction where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Transaction) @Transaction c
@@ -82,7 +82,7 @@ instance TypeInstancesFor Transaction
 
 instance Gram_Term_AtomsFor src ss g Transaction
 instance (Source src, SymInj ss Transaction) => ModuleFor src ss Transaction where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Transaction"] `moduleWhere`
 	 [ "date"     := teTransaction_date
 	 , "postings" := teTransaction_postings
 	 ]
diff --git a/lcc/Hcompta/LCC/Sym/Unit.hs b/lcc/Hcompta/LCC/Sym/Unit.hs
index 5d04c91..c5bccb9 100644
--- a/lcc/Hcompta/LCC/Sym/Unit.hs
+++ b/lcc/Hcompta/LCC/Sym/Unit.hs
@@ -31,7 +31,7 @@ instance (Sym_Unit r1, Sym_Unit r2) => Sym_Unit (Dup r1 r2) where
 instance (Sym_Unit term, Sym_Lambda term) => Sym_Unit (BetaT term)
 
 instance NameTyOf Unit where
-	nameTyOf _c = ["LCC"] `Mod` "Unit"
+	nameTyOf _c = ["Unit"] `Mod` "Unit"
 instance ClassInstancesFor Unit where
 	proveConstraintFor _c (TyApp _ (TyConst _ _ q) c)
 	 | Just HRefl <- proj_ConstKiTy @(K Unit) @Unit c
@@ -44,7 +44,7 @@ instance ClassInstancesFor Unit where
 instance TypeInstancesFor Unit
 instance Gram_Term_AtomsFor src ss g Unit
 instance (Source src, SymInj ss Unit) => ModuleFor src ss Unit where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Unit"] `moduleWhere`
 	 [
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Zeroable.hs b/lcc/Hcompta/LCC/Sym/Zeroable.hs
index cce774c..940fea6 100644
--- a/lcc/Hcompta/LCC/Sym/Zeroable.hs
+++ b/lcc/Hcompta/LCC/Sym/Zeroable.hs
@@ -25,13 +25,13 @@ instance (Sym_Zeroable r1, Sym_Zeroable r2) => Sym_Zeroable (Dup r1 r2) where
 instance (Sym_Zeroable term, Sym_Lambda term) => Sym_Zeroable (BetaT term)
 
 instance NameTyOf Zeroable where
-	nameTyOf _c = ["LCC"] `Mod` "Zeroable"
+	nameTyOf _c = ["Zeroable"] `Mod` "Zeroable"
 instance FixityOf Zeroable
 instance ClassInstancesFor Zeroable
 instance TypeInstancesFor Zeroable
 instance Gram_Term_AtomsFor src ss g Zeroable
 instance (Source src, SymInj ss Zeroable) => ModuleFor src ss Zeroable where
-	moduleFor = ["LCC"] `moduleWhere`
+	moduleFor = ["Zeroable"] `moduleWhere`
 	 [ "zero" := teZeroable_zero
 	 ]
 
diff --git a/lcc/Hcompta/LCC/Sym/Zipper.hs b/lcc/Hcompta/LCC/Sym/Zipper.hs
index b35c96a..f8c5ce2 100644
--- a/lcc/Hcompta/LCC/Sym/Zipper.hs
+++ b/lcc/Hcompta/LCC/Sym/Zipper.hs
@@ -120,7 +120,7 @@ instance (Sym_Zipper r1, Sym_Zipper r2) => Sym_Zipper (Dup r1 r2) where
 instance (Sym_Zipper term, Sym_Lambda term) => Sym_Zipper (BetaT term)
 
 instance NameTyOf Zipper where
-	nameTyOf _c = ["LCC", "TreeMap", "Zipper"] `Mod` "Zipper"
+	nameTyOf _c = ["TreeMap", "Zipper"] `Mod` "Zipper"
 instance FixityOf Zipper
 instance ClassInstancesFor Zipper where
 	proveConstraintFor _ (TyApp _ (TyConst _ _ _q) (TyApp _ c _k))
@@ -175,6 +175,6 @@ instance -- Gram_Term_AtomsFor
 			 <$> some (choice $ unicat <$> [Unicat_Letter])
 	-}
 instance (Source src, SymInj ss Zipper) => ModuleFor src ss Zipper where
-	moduleFor = ["LCC", "TreeMap", "Zipper"] `moduleWhere`
+	moduleFor = ["TreeMap", "Zipper"] `moduleWhere`
 	 [
 	 ]
diff --git a/lcc/Hcompta/LCC/Write.hs b/lcc/Hcompta/LCC/Write.hs
new file mode 100644
index 0000000..3408674
--- /dev/null
+++ b/lcc/Hcompta/LCC/Write.hs
@@ -0,0 +1,5 @@
+module Hcompta.LCC.Write
+ ( module Hcompta.LCC.Write.Compta
+ ) where
+
+import Hcompta.LCC.Write.Compta
diff --git a/lcc/Hcompta/LCC/Write/Compta.hs b/lcc/Hcompta/LCC/Write/Compta.hs
new file mode 100644
index 0000000..4ff1793
--- /dev/null
+++ b/lcc/Hcompta/LCC/Write/Compta.hs
@@ -0,0 +1,433 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Hcompta.LCC.Write.Compta where
+
+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.Map.Strict (Map)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Monoid (Monoid(..))
+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 System.IO (IO)
+import qualified Data.ByteString as BS
+import qualified Data.Char as Char
+import qualified Data.List as L
+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.Compta
+import Hcompta.LCC.IO
+import Hcompta.LCC.Journal
+import Hcompta.LCC.Name
+import Hcompta.LCC.Posting
+import Hcompta.LCC.Tag
+import Hcompta.LCC.Transaction
+import qualified Hcompta.LCC.Read.Compta as G
+
+-- * Class 'Writable'
+class Writable d a where
+	write :: a -> d
+-- widthWrite :: forall d a. Writable d a => a -> Integer
+widthWrite = D.width . D.dim . write
+
+-- 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
+	 }
+
+instance (D.Doc_Text d, D.Doc_Color d) =>
+         Writable d Date where
+	write dat =
+		let (y, mo, d) = H.gregorianOf dat in
+		(if y == 0 then D.empty else D.integer y <> sep G.char_ymd_sep) <>
+		int2 mo <>
+		sep G.char_ymd_sep <> int2 d <>
+		(case H.todOf 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
+instance (D.Doc_Text d, D.Doc_Color d, Monoid d) =>
+         Writable d Account where
+	write acct =
+		(`MT.ofoldMap` acct) $ \a ->
+			D.blacker (D.charH G.char_account_sep) <>
+			write a
+instance D.Doc_Text d =>
+         Writable d NameAccount where
+	write = D.textH . unName
+instance (D.Doc_Text d, D.Doc_Color d) =>
+         Writable d Tag_Path where
+	write (Tag_Path path) =
+		D.catH $
+		(:) (D.yellower $ D.charH G.char_account_tag_prefix) $
+		L.intersperse
+		 (D.yellower $ D.charH G.char_tag_sep)
+		 (D.textH . unName <$> NonNull.toNullable path)
+instance (D.Doc_Text d, D.Doc_Color d) =>
+         Writable d Account_Tag where
+	write (Account_Tag (Tag (Tag_Path path) (Tag_Data value))) =
+		D.catH (
+			(:) (D.yellower $ D.charH G.char_account_tag_prefix) $
+			L.intersperse
+			 (D.yellower $ D.charH G.char_tag_sep)
+			 (D.textH . unName <$> NonNull.toNullable path) ) <>
+		if Text.null value
+		then D.empty
+		else
+			D.yellower (D.charH G.char_tag_data_prefix) <>
+			D.textH value
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d) =>
+         Writable d (Styled_Amount Amount) where
+	write
+	 ( sty@Style_Amount
+		 { style_amount_unit_side   = uside
+		 , style_amount_unit_spaced = uspaced
+		 }
+	 , Amount u q
+	 ) =
+		case uside of
+		 S.Just L ->
+			write u <>
+			case uspaced of
+			 S.Just True | not (H.null u) -> D.space
+			 _ -> D.empty
+		 _ -> D.empty
+		<> write (sty, q)
+		<> case uside of
+		 S.Just R ->
+			(case uspaced of
+			 S.Just True | not (H.null u) -> D.space
+			 _ -> D.empty) <>
+			write u
+		 S.Nothing ->
+			(case uspaced of
+			 S.Just True | not (H.null u) -> D.space
+			 _ -> D.empty) <>
+			write u
+		 _ -> D.empty
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d) =>
+         Writable d Unit where
+	write (Unit t) =
+		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
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d) =>
+         Writable d (Styled_Amount Quantity) where
+	write
+	 ( 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 = L.length num
+			let padded =
+				L.concat
+				 [ L.replicate (fromIntegral e + 1 - num_len) '0'
+				 , num
+				 -- , replicate (fromIntegral precision - fromIntegral e) '0'
+				 ]
+			let (int, frac) = L.splitAt (max 1 (num_len - fromIntegral e)) padded
+			let default_fractioning =
+				L.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 -> L.reverse . group g . L.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_) =
+			L.concat . L.reverse .
+			L.map L.reverse . fst .
+			L.foldl'
+			 (flip (\digit x -> case x of
+				 ([], sizes) -> ([[digit]], sizes)
+				 (digits:groups, []) -> ((digit:digits):groups, [])
+				 (digits:groups, curr_sizes@(size:sizes)) ->
+					if L.length digits < size
+					then (      (digit:digits):groups, curr_sizes)
+					else ([digit]:[sep]:digits:groups, if L.null sizes then curr_sizes else sizes)
+			 ))
+			 ([], sizes_)
+		del_grouping_sep grouping =
+			case grouping of
+			 S.Just (Style_Amount_Grouping sep _) -> L.delete sep
+			 _ -> id
+instance (D.Doc_Text d, D.Doc_Color d) =>
+         Writable d Comment where
+	write (Comment com) =
+		D.cyan $
+		D.charH G.char_comment_prefix
+		<> (case Text.uncons com of
+		 Just (c, _) | not $ Char.isSpace c -> D.space
+		 _ -> D.empty)
+		<> D.textH com
+instance (D.Doc_Text d, D.Doc_Color d) =>
+         Writable d (d, [Comment]) where
+	write (prefix, com) =
+		D.catH $
+		L.intersperse D.eol $
+		(\c -> prefix <> write c) <$> com
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d (Context_Write, Posting) where
+	write (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 (d_acct, w_acct) =
+			case posting_account_ref of
+			 S.Just (a S.:!: sa) | context_write_account_ref ctx ->
+				( write a <> S.maybe D.empty write sa
+				, widthWrite a + S.maybe 0 widthWrite sa )
+			 _ -> (write posting_account, widthWrite posting_account) in
+		(case posting_amounts of
+		 Amounts amts | Map.null amts -> d_acct
+		 Amounts amts ->
+			fromMaybe D.empty $
+			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 + widthWrite amt) in
+				(case mdoc of
+				 Nothing -> D.empty
+				 Just doc -> doc <> D.eol <> d_indent) <>
+				d_acct <> D.spaces pad <> D.space <> write amt
+			 ) Nothing amts) <>
+		(case posting_comments of
+		 []  -> D.empty
+		 [c] -> D.space <> write c
+		 _   -> D.eol   <> write (d_indent <> D.space :: d, posting_comments))
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d (Context_Write, Transaction) where
+	write (ctx,
+	 txn@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_Transaction ctx txn
+			else w } in
+		D.catH (
+			L.intersperse
+			 (D.charH G.char_transaction_date_sep)
+			 (write <$> 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
+		 _  -> write (D.space :: d, transaction_comments) <> D.eol) <>
+		TreeMap.foldr_with_Path
+		 (\path -> flip $
+			foldr (\value -> (<>) (D.spaces 2 <>
+			write (Transaction_Tag (Tag (Tag_Path path) value)) <> D.eol)))
+		 D.empty tags <>
+		D.catV (write . (ctx',) <$> Compose transaction_postings)
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d (Context_Write, Map Date [Transaction]) where
+	write (ctx, txns) =
+		let ctx' = ctx{context_write_width_acct_amt =
+			foldr (max . w_Transaction ctx) 0 $ Compose txns} in
+		fromMaybe D.empty $
+		foldl (\mdoc txn -> Just $
+			write (ctx', txn) <>
+			case mdoc of
+			 Nothing  -> D.eol
+			 Just doc -> D.eol <> D.eol <> doc
+		 ) Nothing (Compose txns)
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d Transaction_Tag where
+	write (Transaction_Tag (Tag (Tag_Path path) (Tag_Data value))) =
+		D.catH (
+			(:) (D.yellower $ D.charH G.char_tag_prefix) $
+			L.intersperse
+			 (D.yellower $ D.charH G.char_tag_sep)
+			 (D.bold . D.textH . unName <$> NonNull.toNullable path)) <>
+		if Text.null value
+		then D.empty
+		else D.yellower (D.charH G.char_tag_data_prefix) <> D.textH value
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d, Writable d (ctx, j)) =>
+         Writable d (ctx, Journal j) where
+	write (ctx, jnl) = write (ctx, journal_content jnl)
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d, Writable d (ctx, j)) =>
+         Writable d (ctx, Journals j) where
+	write (ctx, Journals js) =
+		Map.foldl
+		 (\doc j@Journal{journal_file=PathFile jf} ->
+			doc <>
+			write (Comment $ Text.pack jf) <> D.eol <>
+			D.eol <> write (ctx, j)
+		 ) D.empty js
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d Chart where
+	write =
+		TreeMap.foldl_with_Path
+		 (\doc acct (Account_Tags (Tags ca)) ->
+			doc <>
+			write (H.to acct :: Account) <> D.eol <>
+			TreeMap.foldl_with_Path
+			 (\doc' tp tvs ->
+				doc' <>
+				foldl'
+				 (\doc'' tv ->
+					doc'' <> D.spaces 2 <>
+					write (Account_Tag (Tag (Tag_Path tp) tv)) <>
+					D.eol)
+				 D.empty
+				 tvs)
+			 D.empty
+			 ca
+		 ) D.empty .
+		chart_accounts
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d) =>
+         Writable d Terms where
+	write (ts::Terms) =
+		Map.foldl (\doc t -> doc <> D.text t <> D.eol) D.empty ts
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d, Monoid d, Writable d (Context_Write, j)) =>
+         Writable d (Context_Write, Compta src ss j) where
+	write (ctx, Compta
+	 { compta_journals      = js
+	 , compta_chart         = c@Chart{chart_accounts=ca}
+	 , compta_style_amounts = amts
+	 , compta_terms         = terms
+	 }) =
+		(if null terms then D.empty else (write terms <> D.eol)) <>
+		(if TreeMap.null ca then D.empty else (write c <> D.eol)) <>
+		write (ctx{context_write_amounts = context_write_amounts ctx <> amts}, js)
+instance (D.Doc_Text d, D.Doc_Color d, D.Doc_Decoration d) =>
+         Writable (IO d) SourcePos where
+	write (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 =
+			L.take (intFrom $ (l - ll) + 1 + size_ctx) $
+			L.drop (intFrom $ ll-1) ls
+		let ns = show <$> L.take (L.length qs) [ll..]
+		let max_len_n = maximum $ 0 : (L.length <$> ns)
+		let ns' = (<$> ns) $ \n ->
+			L.replicate (max_len_n - L.length n) ' ' <> n
+		let quote =
+			D.catV $
+			L.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)
+			 ) (L.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'
+
+-- | Return the width of given 'Postings',
+-- considering only 'Account's and 'Amount's (not indentation, 'Comment's, nor 'Posting_Tag's).
+w_Transaction :: Context_Write -> Transaction -> Int
+-- w_Postings ctx = MT.ofoldr (max . widthWrite ctx) 0
+w_Transaction 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 ->
+				widthWrite a + S.maybe 0 widthWrite sa
+			 _ -> widthWrite 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
+					widthWrite amt)
+				 1 amts in
+		w_Acct + w_Amt
+	 ) 0 .
+	transaction_postings
diff --git a/lcc/hcompta-lcc.cabal b/lcc/hcompta-lcc.cabal
index 09cee68..269ddc4 100644
--- a/lcc/hcompta-lcc.cabal
+++ b/lcc/hcompta-lcc.cabal
@@ -83,16 +83,15 @@ Library
     Hcompta.LCC.Balance
     Hcompta.LCC.Chart
     Hcompta.LCC.Compta
-    Hcompta.LCC.Document
-    Hcompta.LCC.Grammar
     Hcompta.LCC.IO
     Hcompta.LCC.Journal
     Hcompta.LCC.Lib.FilePath
     Hcompta.LCC.Lib.Strict
-    Hcompta.LCC.Megaparsec
     Hcompta.LCC.Name
     Hcompta.LCC.Posting
     Hcompta.LCC.Read
+    Hcompta.LCC.Read.Compta
+    Hcompta.LCC.Read.Megaparsec
     Hcompta.LCC.Source
     Hcompta.LCC.Sym
     Hcompta.LCC.Sym.Account
@@ -116,6 +115,9 @@ Library
     Hcompta.LCC.Sym.Zipper
     Hcompta.LCC.Tag
     Hcompta.LCC.Transaction
+    Hcompta.LCC.Write
+    Hcompta.LCC.Write.Compta
+    Hcompta.LCC.Write.Table
   build-depends:
     base >= 4.6 && < 5
     , ansi-terminal >= 0.4 && < 0.7
-- 
2.47.0