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

import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
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)
instance Show Pos where
	showsPrec _p pos = showsPrec 11 (linePos pos,columnPos pos)
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