Language/TCT/Cell.hs

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