module Language.Symantic.Document.Dim where

import Data.Foldable (Foldable(..))
import Data.Function (($), id)
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Prelude (min, max, Num(..), toInteger)
import Text.Show (Show(..))
import qualified Data.List as List
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
 , height      :: Int
 , width_first :: Int
 , width_last  :: Int
 } deriving (Show)
instance IsString Dim where
	fromString [] = Dim 0 0 0 0
	fromString s =
		Dim
		 { width       = maximum ws
		 , height      = length ls
		 , width_first = List.head ws
		 , width_last  = List.last ws
		 }
		where
		ls = lines s
		ws = length <$> ls

dim :: Dim -> Dim
dim = id

instance Semigroup Dim where
	x@(Dim wx hx wfx wlx) <> y@(Dim wy hy wfy wly) =
		let w = max (wlx + wfy) (max wx wy) in
		let h = max 0 $ hx + hy - 1 in
		case (hx, hy) of
		 (0, _) -> y
		 (_, 0) -> x
		 (1, 1) -> let v = wlx + wfy in Dim w h v v
		 (1, _) -> Dim w h (wfx + wfy) wly
		 (_, 1) -> Dim w h wfx (wlx + wfy)
		 _      -> Dim w h wfx wly
instance Monoid Dim where
	mempty  = empty
	mappend = (<>)
instance Doc_Text Dim where
	spaces i  = Dim i 1 i 1
	int i     = fromString $ show i
	integer i = fromString $ show i
	charH _c  = Dim 1 1 1 1
	stringH t = Dim l h l l where h = min 1 l; l = length t
	textH t   = Dim l h l l where h = min 1 l; l = T.length t
	ltextH t  = Dim l h l l where h = min 1 l; l = fromInteger $ toInteger $ TL.length t
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