]> Git — Sourcephile - doclang.git/blob - Language/TCT/Cell.hs
Add more elements in the <head> of the HTML5 rendering of DTC.
[doclang.git] / 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)
90 instance Show Pos where
91 showsPrec _p pos = showsPrec 11 (linePos pos,columnPos pos)
92 instance Ord Pos where
93 Pos lx cx `compare` Pos ly cy =
94 compare lx ly <>
95 compare cx cy
96
97 posTree :: Tree (Cell k) (Cell a) -> Pos
98 posTree (TreeN c _) = posCell c
99 posTree (Tree0 c) = posCell c
100
101 posEndTree :: Tree (Cell k) (Cell a) -> Pos
102 posEndTree (TreeN c _) = posEndCell c
103 posEndTree (Tree0 c) = posEndCell c
104
105 pos0 :: Pos
106 pos0 = Pos 0 0
107 pos1 :: Pos
108 pos1 = Pos 1 1
109
110 -- ** Type 'Line'
111 -- | Line in the source file, counting from 1.
112 type Line = Int
113
114 -- ** Type 'Column'
115 -- | Column in the source file, counting from 1.
116 type Column = Int