module Language.Symantic.Document.Dim where

import Data.Eq (Eq)
import Data.Foldable (Foldable(..))
import Data.Function (($), id)
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Prelude (max, Num(..), toInteger)
import Text.Show (Show(..))
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Language.Symantic.Document.Sym

-- * Type 'Dim'
data Dim
 =   Dim
 { width       :: Int -- ^ Maximun line length.
 , height      :: Int -- ^ Number of newlines.
 , width_first :: Int -- ^ Length of the first line.
 , width_last  :: Int -- ^ Length of the last line.
 } deriving (Eq, Show)
instance IsString Dim where
	fromString [] = Dim 0 0 0 0
	fromString s =
		Dim
		 { width       = maximum ws
		 , height      = length ls
		 , width_first = if null ws then 0 else L.head ws
		 , width_last  = if null ws then 0 else L.last ws
		 }
		where
		ls = L.lines s
		ws = length <$> ls

dim :: Dim -> Dim
dim = id

instance Semigroup Dim where
	Dim wx hx wfx wlx <> Dim wy hy wfy wly =
		let h = hx + hy in
		case (hx, hy) of
		 (0, 0) -> let w = wx  + wy  in Dim w h w w
		 (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
		 _      -> Dim (max wx wy) h wfx wly
instance Monoid Dim where
	mempty  = empty
	mappend = (<>)
instance Doc_Text Dim where
	spaces    i   = Dim i 0 i i
	replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
	int       i   = fromString $ show i
	integer   i   = fromString $ show i
	charH     _c  = Dim 1 0 1 1
	stringH   t   = Dim l 0 l l where l = length t
	textH     t   = Dim l 0 l l where l = T.length t
	ltextH    t   = Dim l 0 l l where l = fromInteger $ toInteger $ TL.length t
	                                    -- XXX: conversion may overflow
instance Doc_Color Dim where
	reverse     = id
	black       = id
	red         = id
	green       = id
	yellow      = id
	blue        = id
	magenta     = id
	cyan        = id
	white       = id
	blacker     = id
	redder      = id
	greener     = id
	yellower    = id
	bluer       = id
	magentaer   = id
	cyaner      = id
	whiter      = id
	onBlack     = id
	onRed       = id
	onGreen     = id
	onYellow    = id
	onBlue      = id
	onMagenta   = id
	onCyan      = id
	onWhite     = id
	onBlacker   = id
	onRedder    = id
	onGreener   = id
	onYellower  = id
	onBluer     = id
	onMagentaer = id
	onCyaner    = id
	onWhiter    = id
instance Doc_Decoration Dim where
	bold        = id
	underline   = id
	italic      = id