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

import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
-- import Data.Semigroup (Semigroup(..))
import Data.Sequence (Seq, ViewL(..), ViewR(..))
import Data.TreeSeq.Strict (Tree(..))
import Prelude (Int)
import Text.Show (Show(..), showParen, showString, showChar)
import qualified Data.Sequence as Seq

-- * Type 'Cell'
-- | NOTE: every 'Cell' as a 'Pos',
--         which is useful to indicate matches/errors/warnings/whatever,
--         or outputing in a format somehow preserving
--         the original input style.
data Cell a
 =   Cell
 { posCell    :: {-# UNPACK #-} !Pos
 , posEndCell :: {-# UNPACK #-} !Pos
 , unCell     :: a
 } deriving (Eq, Ord, Functor)
instance Show a => Show (Cell a) where
	showsPrec p Cell{..} =
		showParen (p >= 10) $
		showString "Cell" .
		showChar ' ' . showsPrec 10 posCell .
		showChar ' ' . showsPrec 10 posEndCell .
		showChar ' ' . showsPrec 11 unCell
{-
instance Semigroup a => Semigroup (Cell a) where
	Cell bx ex x <> Cell by ey y =
		Cell (bx`min`by) (ex`max`ey) (x<>y)
instance (Monoid a, Semigroup a) => Monoid (Cell a) where
	mempty  = Cell pos1 pos1 mempty
	mappend = (<>)
-}

lineCell :: Cell a -> Line
lineCell = linePos . posCell
columnCell :: Cell a -> Column
columnCell = columnPos . posCell

cell0 :: a -> Cell a
cell0 = Cell pos0 pos0
cell1 :: a -> Cell a
cell1 = Cell pos1 pos1

posSeq :: Seq (Cell a) -> Maybe (Pos,Pos)
posSeq toks =
	case Seq.viewl toks of
	 EmptyL -> Nothing
	 Cell bp _ep _ :< _ ->
		case Seq.viewr toks of
		 EmptyR -> Nothing
		 _ :> Cell _bp ep _ ->
			Just (bp, ep)

{-
posTrees :: Seq (Trees (Cell k) a) -> Maybe (Pos,Pos)
posTrees trees =
	case Seq.viewl trees of
	 EmptyL -> Nothing
	 Tree0 toks :< ts ->
		case posSeq toks of
		 Nothing -> posTrees ts
		 Just (bp,_ep) ->
			Just $
				case Seq.viewr trees of
				 EmptyR -> (bp,bp)
				 _ :> TreeN _ toks | iiiii->
			
	 TreeN (Cell bp _ep _) _ :< _ ->
		case Seq.viewr trees of
		 EmptyR -> Nothing
		 _ :> TreeN _ toks | iiiii->
			Just (Cell bp ep ())
-}

-- * Type 'Pos'
data Pos
 =   Pos
 {   linePos   :: {-# UNPACK #-} !Line
 ,   columnPos :: {-# UNPACK #-} !Column
 } deriving (Eq, Ord)
instance Show Pos where
	showsPrec _p Pos{..} = showsPrec 11 (linePos,columnPos)
{-
instance Ord Pos where
	Pos lx cx `compare` Pos ly cy =
		compare lx ly <>
		compare cx cy
-}

posTree :: Tree (Cell k) (Cell a) -> Pos
posTree (TreeN c _) = posCell c
posTree (Tree0 c)   = posCell c

posEndTree :: Tree (Cell k) (Cell a) -> Pos
posEndTree (TreeN c _) = posEndCell c
posEndTree (Tree0 c)   = posEndCell c

pos0 :: Pos
pos0 = Pos 0 0
pos1 :: Pos
pos1 = Pos 1 1

-- ** Type 'Line'
-- | Line in the source file, counting from 1.
type Line = Int

-- ** Type 'Column'
-- | Column in the source file, counting from 1.
type Column = Int