{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Hdoc.TCT.Cell
 ( module Hdoc.TCT.Cell
 , XML.FileRange(..)
 , XML.NoSource(..)
 , XML.Sourced(..)
 ) where

import Control.Applicative (Applicative(..))
import Data.Bool
import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Language.Symantic.XML (Sourced(..))
import Prelude (Bounded(..), (-), Int, fromIntegral, Integral, Num)
import Text.Show (Show(..), showChar, showString)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Language.Symantic.XML as XML
import qualified Text.Megaparsec as P

import Hdoc.TCT.Debug

{-
-- * Type 'Pos'
-- | Absolute text file position.
type Pos = XML.FileRange XML.LineColumn
instance Semigroup Pos where
	Pos lx cx <> Pos ly cy =
		Pos (lx+ly) (cx+cy)
instance Monoid Pos where
	mempty  = Pos 0 0
	mappend = (<>)

pos1 :: Pos
pos1 = def
-}

-- * Type 'Cell'
type Cell = XML.Sourced Location
{-
instance (FromPad a, Semigroup a, Monoid a) => Monoid (Cell a) where
	mempty  = cell0 mempty
	mappend = (<>)
-}

cell0 :: a -> Cell a
cell0 = XML.Sourced (XML.FileRange "" pos0 pos0 :| [])
	where
	pos0 = LineColumn num0 num0
	num0 = numMax<>numMax<>pos1<>pos1
	numMax = P.mkPos maxBound

-- ** Type 'Span'
type Span = XML.FileRange LineColumn

-- ** Type 'Location'
type Location = XML.FileSource LineColumn

instance (FromPad a, Semigroup a) => Semigroup (Sourced (XML.FileSource LineColumn) a) where
	(<>)
	 (Sourced rx@(XML.FileRange xf xb xe :|  xs) x)
	 (Sourced    (XML.FileRange yf yb ye :| _ys) y)
	 | xf == yf  = Sourced (XML.FileRange xf xb ye :| xs) $
	                       x<>fromPad (l,c)<>y
	 | otherwise = Sourced rx (x<>y)
		where
		l = lineInt yb - lineInt xe
		c = colInt  yb - colInt (if l <= 0 then xe else xb)

-- ** Class 'FromPad'
class FromPad a where
	fromPad :: (Int, Int) -> a
instance FromPad T.Text where
	fromPad (lineNum, colNum) =
		T.replicate lineNum "\n" <>
		T.replicate colNum " "
instance FromPad TL.Text where
	fromPad (lineNum, colNum) =
		TL.replicate (fromIntegral lineNum) "\n" <>
		TL.replicate (fromIntegral colNum) " "
instance FromPad XML.EscapedText where
	fromPad = XML.EscapedText . pure . fromPad
instance FromPad XML.Escaped where
	fromPad = XML.EscapedPlain . fromPad
{-
instance (FromPad a, Semigroup a, Monoid a) => Monoid (Sourced a) where
	mempty  = sourced0 mempty
	mappend = (<>)
-}

-- ** Type 'LineColumn'
-- | Absolute text file position.
data LineColumn = LineColumn
 { lineNum :: {-# UNPACK #-} !P.Pos
 , colNum  :: {-# UNPACK #-} !P.Pos
 } deriving (Eq, Ord)
num :: (Integral a, Num a) => a -> P.Pos
num = P.mkPos . fromIntegral
pos1 :: P.Pos
pos1 = P.pos1
instance Default LineColumn where
	def = LineColumn P.pos1 P.pos1
instance Show LineColumn where
	showsPrec _p lc =
		showsPrec 11 (lineInt lc) .
		showChar ':' .
		showsPrec 11 (colInt lc)
instance Pretty LineColumn

-- ** Type 'LineInt'
type LineInt = Int
lineInt :: LineColumn -> Int
lineInt = P.unPos . lineNum

-- ** Type 'ColInt'
type ColInt = Int
colInt :: LineColumn -> Int
colInt = P.unPos . colNum
instance Default (XML.FileRange LineColumn) where
	def = XML.FileRange "" def def
instance Show (XML.FileRange LineColumn) where
	showsPrec _p XML.FileRange{..} =
		showString fileRange_file .
		showChar '#' . showsPrec 10 fileRange_begin .
		showChar '-' . showsPrec 10 fileRange_end