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