module Language.Symantic.Document.Dim where

{-
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), id)
import Data.Functor ((<$>), ($>))
import Data.Int (Int)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Prelude (max, Num(..), toInteger)
import Text.Show (Show(..))
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Control.Monad.Trans.State as S

import Language.Symantic.Document.Sym

-- * Type 'Dim'
data Dim
 =   Dim
 {   dim_width       :: Int -- ^ Maximun line length.
 ,   dim_height      :: Int -- ^ Number of newlines.
 ,   dim_width_first :: Int -- ^ Length of the first line.
 ,   dim_width_last  :: Int -- ^ Length of the last line.
 } deriving (Eq, Show)
instance Semigroup Dim where
	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
	 Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
		let h = hx + hy in
		case (hx, hy) of
		 (0, 0) -> let w = wx  + wy  in Dim w h w w
		 (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
		 _      -> Dim (max wx wy) h wfx wly
instance Monoid Dim where
	mempty  = Dim 0 0 0 0
	mappend = (<>)

-- * Type 'Dimension'
newtype Dimension = Dimension { unDimension :: Inh -> S.State Column Dim }

instance IsString Dimension where
	fromString [] = mempty
	fromString s =
		Dimension $ \inh ->
			let ls = L.lines s in
			return $
			case inh_newline inh of
			 NewlineEmpty ->
				let w = sum $ length <$> ls in
				Dim
				 { dim_width       = w
				 , dim_height      = 0
				 , dim_width_first = w
				 , dim_width_last  = w
				 }
			 NewlineWithIndent ->
				let ws = case length <$> ls of [] -> []; c:cs -> c : ((inh_indent inh +)<$>cs) in
				Dim
				 { dim_width       = maximum ws
				 , dim_height      = length ls
				 , dim_width_first = if null ws then 0 else L.head ws
				 , dim_width_last  = if null ws then 0 else L.last ws
				 }
			 NewlineWithoutIndent ->
				let ws = length <$> ls in
				Dim
				 { dim_width       = maximum ws
				 , dim_height      = length ls
				 , dim_width_first = if null ws then 0 else L.head ws
				 , dim_width_last  = if null ws then 0 else L.last ws
				 }

dimension :: Dimension -> Dimension
dimension = id


instance Semigroup Dimension where
	-- Dimension x <> Dimension y = Dimension (x <> y)
	Dimension x <> Dimension y = Dimension (\inh -> (<>) <$> x inh <*> y inh)
instance Monoid Dimension where
	mempty  = empty
	mappend = (<>)
instance Doc_Text Dimension where
	spaces    i   = Dimension $ \_inh -> return $ Dim i 0 i i
	replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
	int       i   = stringH $ show i
	integer   i   = stringH $ show i
	empty         = Dimension $ \_inh -> return mempty
	newline       = Dimension $ \_inh -> return $ Dim 0 1 0 0
	charH     _c  = incrColumn $ 1
	stringH   t   = incrColumn $ length t
	textH     t   = incrColumn $ T.length t
	ltextH    t   = incrColumn $ fromInteger $ toInteger $ TL.length t
	                                    -- XXX: conversion may overflow
instance Doc_Color Dimension where
	reverse     = id
	black       = id
	red         = id
	green       = id
	yellow      = id
	blue        = id
	magenta     = id
	cyan        = id
	white       = id
	blacker     = id
	redder      = id
	greener     = id
	yellower    = id
	bluer       = id
	magentaer   = id
	cyaner      = id
	whiter      = id
	onBlack     = id
	onRed       = id
	onGreen     = id
	onYellow    = id
	onBlue      = id
	onMagenta   = id
	onCyan      = id
	onWhite     = id
	onBlacker   = id
	onRedder    = id
	onGreener   = id
	onYellower  = id
	onBluer     = id
	onMagentaer = id
	onCyaner    = id
	onWhiter    = id
instance Doc_Decoration Dimension where
	bold        = id
	underline   = id
	italic      = id
instance Doc_Align Dimension where
instance Doc_Wrap Dimension where
-}