]> Git — Sourcephile - doclang.git/blob - Hdoc/TCT/Cell.hs
fixup! Add PairAt, TokenAt and PlainAt.
[doclang.git] / Hdoc / TCT / Cell.hs
1 {-# LANGUAGE DeriveFunctor #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 module Hdoc.TCT.Cell where
5
6 import Data.Default.Class (Default(..))
7 import Data.Eq (Eq(..))
8 import Data.Foldable (toList)
9 import Data.Function (($), (.))
10 import Data.Functor (Functor)
11 import Data.List.NonEmpty (NonEmpty(..))
12 import Data.Ord (Ord(..))
13 import Data.Semigroup (Semigroup(..))
14 import Data.Text (Text)
15 import Prelude (Int, Num(..), fromIntegral)
16 import System.FilePath (FilePath)
17 import Text.Show (Show(..), showChar, showString, showParen)
18 import qualified Data.Text as Text
19 import qualified Data.Text.Lazy as TL
20
21 import Hdoc.TCT.Debug
22
23 -- * Type 'Pos'
24 -- | Absolute text file position.
25 data Pos = Pos
26 { pos_line :: {-# UNPACK #-} !LineNum
27 , pos_column :: {-# UNPACK #-} !ColNum
28 } deriving (Eq, Ord)
29 instance Default Pos where
30 def = pos1
31 {-
32 instance Semigroup Pos where
33 Pos lx cx <> Pos ly cy =
34 Pos (lx+ly) (cx+cy)
35 instance Monoid Pos where
36 mempty = Pos 0 0
37 mappend = (<>)
38 -}
39 instance Show Pos where
40 showsPrec _p Pos{..} =
41 showsPrec 11 pos_line .
42 showChar ':' .
43 showsPrec 11 pos_column
44 instance Pretty Pos
45
46 pos1 :: Pos
47 pos1 = Pos 1 1
48
49 -- ** Type 'LineNum'
50 type LineNum = Int
51
52 -- ** Type 'ColNum'
53 type ColNum = Int
54
55 -- * Type 'Cell'
56 data Cell a
57 = Cell
58 { cell_location :: !Location
59 , unCell :: !a
60 } deriving (Eq, Ord, Functor)
61 instance Show a => Show (Cell a) where
62 showsPrec p Cell{..} =
63 showParen (p > 10) $
64 showString "Cell" .
65 showChar ' ' . showsPrec 11 unCell .
66 showChar ' ' . showsPrec 10 (toList cell_location)
67 instance (Pretty a, Show a) => Pretty (Cell a)
68 instance (FromPad a, Semigroup a) => Semigroup (Cell a) where
69 Cell (Span fx bx ex :| lx) x <> Cell (Span _fy by ey :| _ly) y =
70 Cell (Span fx bx ey :| lx) $
71 x<>fromPad (Pos lines columns)<>y
72 where
73 lines = pos_line by - pos_line ex
74 columns = pos_column by - pos_column (if lines <= 0 then ex else bx)
75 {-
76 instance (FromPad a, Semigroup a, Monoid a) => Monoid (Cell a) where
77 mempty = cell0 mempty
78 mappend = (<>)
79 -}
80
81 cell0 :: a -> Cell a
82 cell0 = Cell (def :| [])
83
84 -- ** Type 'Span'
85 data Span
86 = Span
87 { span_file :: !FilePath
88 , span_begin :: !Pos
89 , span_end :: !Pos
90 } deriving (Eq, Ord)
91 instance Default Span where
92 def = Span "" pos1 pos1
93 instance Show Span where
94 showsPrec _p Span{..} =
95 showString span_file .
96 showChar '#' . showsPrec 10 span_begin .
97 showChar '-' . showsPrec 10 span_end
98
99 -- ** Type 'Location'
100 type Location = NonEmpty Span
101
102 -- * Class 'FromPad'
103 class FromPad a where
104 fromPad :: Pos -> a
105 instance FromPad Text where
106 fromPad Pos{..} =
107 Text.replicate pos_line "\n" <>
108 Text.replicate pos_column " "
109 instance FromPad TL.Text where
110 fromPad Pos{..} =
111 TL.replicate (fromIntegral pos_line) "\n" <>
112 TL.replicate (fromIntegral pos_column) " "