Language/TCT/Cell.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 module Language.TCT.Cell where
   3
   4 import Data.Eq (Eq(..))
   5 import Data.Function (($), (.))
   6 import Data.Functor (Functor)
   7 import Data.Maybe (Maybe(..))
   8 import Data.Ord (Ord(..))
   9 -- import Data.Semigroup (Semigroup(..))
  10 import Data.Sequence (Seq, ViewL(..), ViewR(..))
  11 import Data.TreeSeq.Strict (Tree(..))
  12 import Prelude (Int)
  13 import Text.Show (Show(..), showParen, showString, showChar)
  14 import qualified Data.Sequence as Seq
  15
  16 -- * Type 'Cell'
  17 -- | NOTE: every 'Cell' as a 'Pos',
  18 --         which is useful to indicate matches/errors/warnings/whatever,
  19 --         or outputing in a format somehow preserving
  20 --         the original input style.
  21 data Cell a
  22  =   Cell
  23  { posCell    :: {-# UNPACK #-} !Pos
  24  , posEndCell :: {-# UNPACK #-} !Pos
  25  , unCell     :: a
  26  } deriving (Eq, Ord, Functor)
  27 instance Show a => Show (Cell a) where
  28         showsPrec p Cell{..} =
  29                 showParen (p >= 10) $
  30                 showString "Cell" .
  31                 showChar ' ' . showsPrec 10 posCell .
  32                 showChar ' ' . showsPrec 10 posEndCell .
  33                 showChar ' ' . showsPrec 11 unCell
  34 {-
  35 instance Semigroup a => Semigroup (Cell a) where
  36         Cell bx ex x <> Cell by ey y =
  37                 Cell (bx`min`by) (ex`max`ey) (x<>y)
  38 instance (Monoid a, Semigroup a) => Monoid (Cell a) where
  39         mempty  = Cell pos1 pos1 mempty
  40         mappend = (<>)
  41 -}
  42
  43 lineCell :: Cell a -> Line
  44 lineCell = linePos . posCell
  45 columnCell :: Cell a -> Column
  46 columnCell = columnPos . posCell
  47
  48 cell0 :: a -> Cell a
  49 cell0 = Cell pos0 pos0
  50 cell1 :: a -> Cell a
  51 cell1 = Cell pos1 pos1
  52
  53 posSeq :: Seq (Cell a) -> Maybe (Pos,Pos)
  54 posSeq toks =
  55         case Seq.viewl toks of
  56          EmptyL -> Nothing
  57          Cell bp _ep _ :< _ ->
  58                 case Seq.viewr toks of
  59                  EmptyR -> Nothing
  60                  _ :> Cell _bp ep _ ->
  61                         Just (bp, ep)
  62
  63 {-
  64 posTrees :: Seq (Trees (Cell k) a) -> Maybe (Pos,Pos)
  65 posTrees trees =
  66         case Seq.viewl trees of
  67          EmptyL -> Nothing
  68          Tree0 toks :< ts ->
  69                 case posSeq toks of
  70                  Nothing -> posTrees ts
  71                  Just (bp,_ep) ->
  72                         Just $
  73                                 case Seq.viewr trees of
  74                                  EmptyR -> (bp,bp)
  75                                  _ :> TreeN _ toks | iiiii->
  76
  77          TreeN (Cell bp _ep _) _ :< _ ->
  78                 case Seq.viewr trees of
  79                  EmptyR -> Nothing
  80                  _ :> TreeN _ toks | iiiii->
  81                         Just (Cell bp ep ())
  82 -}
  83
  84 -- * Type 'Pos'
  85 data Pos
  86  =   Pos
  87  {   linePos   :: {-# UNPACK #-} !Line
  88  ,   columnPos :: {-# UNPACK #-} !Column
  89  } deriving (Eq, Ord)
  90 instance Show Pos where
  91         showsPrec _p Pos{..} = showsPrec 11 (linePos,columnPos)
  92 {-
  93 instance Ord Pos where
  94         Pos lx cx `compare` Pos ly cy =
  95                 compare lx ly <>
  96                 compare cx cy
  97 -}
  98
  99 posTree :: Tree (Cell k) (Cell a) -> Pos
 100 posTree (TreeN c _) = posCell c
 101 posTree (Tree0 c)   = posCell c
 102
 103 posEndTree :: Tree (Cell k) (Cell a) -> Pos
 104 posEndTree (TreeN c _) = posEndCell c
 105 posEndTree (Tree0 c)   = posEndCell c
 106
 107 pos0 :: Pos
 108 pos0 = Pos 0 0
 109 pos1 :: Pos
 110 pos1 = Pos 1 1
 111
 112 -- ** Type 'Line'
 113 -- | Line in the source file, counting from 1.
 114 type Line = Int
 115
 116 -- ** Type 'Column'
 117 -- | Column in the source file, counting from 1.
 118 type Column = Int