]> Git — Sourcephile - doclang.git/blob - Language/TCT/Cell.hs
Automatize localesOf.
[doclang.git] / 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