{-# 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