{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.TCT.Cell where

import Control.Monad (Monad(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Prelude (Int, Num(..), fromIntegral)
import Text.Show (Show(..), showParen, showString, showChar)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL

import Language.TCT.Debug

-- * Type 'Pos'
-- | Relative position
data Pos
 =   Pos
 {   pos_line   :: {-# UNPACK #-} !LineNum
 ,   pos_column :: {-# UNPACK #-} !ColNum
 } deriving (Eq)
instance Semigroup Pos where
	Pos lx cx <> Pos ly cy =
		Pos (lx+ly) (cx+cy)
instance Monoid Pos where
	mempty  = Pos 0 0
	mappend = (<>)
instance Show Pos where
	showsPrec _p Pos{..} =
		showsPrec 11 pos_line .
		showChar ':' .
		showsPrec 11 pos_column

pos1 :: Pos
pos1 = Pos 1 1

-- ** Type 'LineNum'
type LineNum = Int

-- ** Type 'ColNum'
type ColNum = Int

-- * Type 'Cell'
data Cell a
 =   Cell
 {   cell_begin :: {-# UNPACK #-} !Pos
 ,   cell_end   :: {-# UNPACK #-} !Pos
 , unCell       :: !a
 }   deriving (Eq, Functor)
instance Show a => Show (Cell a) where
	showsPrec p Cell{..} =
		showParen (p >= 10) $
		showString "Cell" .
		showChar ' ' . showsPrec 10 cell_begin .
		showChar ' ' . showsPrec 10 cell_end .
		showChar ' ' . showsPrec 11 unCell
instance Pretty a => Pretty (Cell a) where
	pretty (Cell bp ep m) = do
		s <- pretty m
		return $ "Cell "<>show bp<>":"<>show ep<>" "<>s
instance (FromPad a, Semigroup a) => Semigroup (Cell a) where
	Cell bx (Pos lx cx) x <> Cell (Pos ly cy) ey y =
		Cell bx ey $
			x <> fromPad pad <> y
		where
		pad = Pos lyx $ if lyx == 0 then cy - cx else cy
		lyx = ly - lx
instance (FromPad a, Semigroup a, Monoid a) => Monoid (Cell a) where
	mempty  = cell0 mempty
	mappend = (<>)

cell0 :: a -> Cell a
cell0 = Cell mempty mempty

-- * Class 'FromPad'
class FromPad a where
	fromPad :: Pos -> a
instance FromPad Text where
	fromPad Pos{..} =
		Text.replicate pos_line   "\n" <>
		Text.replicate pos_column " "
instance FromPad TL.Text where
	fromPad Pos{..} =
		TL.replicate (fromIntegral pos_line)   "\n" <>
		TL.replicate (fromIntegral pos_column) " "