{-# 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
instance Pretty Pos

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 ex x <> Cell by ey y =
		Cell bx ey $
			x<>fromPad (Pos lines columns)<>y
		where
		lines   = pos_line   by - pos_line ex
		columns = pos_column by - pos_column (if lines <= 0 then ex else bx)
{-
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) " "