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

import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
import Data.Foldable (toList)
import Data.Function (($), (.))
import Data.Functor (Functor)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Prelude (Int, Num(..), fromIntegral)
import System.FilePath (FilePath)
import Text.Show (Show(..), showChar, showString, showParen)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL

import Hdoc.TCT.Debug

-- * Type 'Pos'
-- | Relative position
data Pos
 =   Pos
 {   pos_line   :: {-# UNPACK #-} !LineNum
 ,   pos_column :: {-# UNPACK #-} !ColNum
 } deriving (Eq, Ord)
instance Default Pos where
	def = pos1
{-
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 'Span'
data Span
 =   Span
 {   span_file  :: !FilePath
 ,   span_begin :: !Pos
 ,   span_end   :: !Pos
 } deriving (Eq, Ord)
instance Default Span where
	def = Span "" pos1 pos1
instance Show Span where
	showsPrec _p Span{..} =
		showString span_file .
		showChar '#' . showsPrec 10 span_begin .
		showChar '-' . showsPrec 10 span_end

-- * Type 'Spans'
type Spans = NonEmpty Span

-- * Type 'Cell'
data Cell a
 =   Cell
 {   cell_spans :: !Spans
 , unCell       :: !a
 } deriving (Eq, Ord, Functor)
instance Show a => Show (Cell a) where
	showsPrec p Cell{..} =
		showParen (p > 10) $
		showString "Cell" .
		showChar ' ' . showsPrec 11 unCell .
		showChar ' ' . showsPrec 10 (toList cell_spans)
instance (Pretty a, Show a) => Pretty (Cell a)
instance (FromPad a, Semigroup a) => Semigroup (Cell a) where
	Cell (Span fx bx ex :| sx) x <> Cell (Span _fy by ey :| _sy) y =
		Cell (Span fx bx ey :| sx) $
			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 (def :| [])

-- * 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) " "