1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Sources
Copyright : Copyright (C) 2021 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Defines Sources object to be used as input to pandoc parsers and redefines Char
parsers so they get source position information from it.
-}
module Text.Pandoc.Sources
( Sources(..)
, ToSources(..)
, UpdateSourcePos(..)
, sourcesToText
, initialSourceName
, addToSources
, ensureFinalNewlines
, addToInput
, satisfy
, oneOf
, noneOf
, anyChar
, char
, string
, newline
, space
, spaces
, letter
, digit
, hexDigit
, alphaNum
)
where
import qualified Text.Parsec as P
import Text.Parsec (Stream(..), ParsecT)
import Text.Parsec.Pos as P
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isSpace, isLetter, isAlphaNum, isDigit, isHexDigit)
import Data.String (IsString(..))
import qualified Data.List.NonEmpty as NonEmpty
-- | A list of inputs labeled with source positions. It is assumed
-- that the 'Text's have @\n@ line endings.
newtype Sources = Sources { unSources :: [(SourcePos, Text)] }
deriving (Show, Semigroup, Monoid)
instance Monad m => Stream Sources m Char where
uncons (Sources []) = return Nothing
uncons (Sources ((pos,t):rest)) =
case T.uncons t of
Nothing -> uncons (Sources rest)
Just (c,t') -> return $ Just (c, Sources ((pos,t'):rest))
instance IsString Sources where
fromString s = Sources [(P.initialPos "", T.pack (filter (/='\r') s))]
class ToSources a where
toSources :: a -> Sources
instance ToSources Text where
toSources t = Sources [(P.initialPos "", T.filter (/='\r') t)]
instance ToSources [(FilePath, Text)] where
toSources = Sources
. map (\(fp,t) ->
(P.initialPos fp, T.snoc (T.filter (/='\r') t) '\n'))
instance ToSources Sources where
toSources = id
sourcesToText :: Sources -> Text
sourcesToText (Sources xs) = mconcat $ map snd xs
addToSources :: Monad m => SourcePos -> Text -> ParsecT Sources u m ()
addToSources pos t = do
curpos <- P.getPosition
Sources xs <- P.getInput
let xs' = case xs of
[] -> []
((_,t'):rest) -> (curpos,t'):rest
P.setInput $ Sources ((pos, T.filter (/='\r') t):xs')
ensureFinalNewlines :: Int -- ^ number of trailing newlines
-> Sources
-> Sources
ensureFinalNewlines n (Sources xs) =
case NonEmpty.nonEmpty xs of
Nothing -> Sources [(initialPos "", T.replicate n "\n")]
Just lst ->
case NonEmpty.last lst of
(spos, t) ->
case T.length (T.takeWhileEnd (=='\n') t) of
len | len >= n -> Sources xs
| otherwise -> Sources (NonEmpty.init lst ++
[(spos,
t <> T.replicate (n - len) "\n")])
class UpdateSourcePos s c where
updateSourcePos :: SourcePos -> c -> s -> SourcePos
instance UpdateSourcePos Text Char where
updateSourcePos pos c _ = updatePosChar pos c
instance UpdateSourcePos Sources Char where
updateSourcePos pos c sources =
case sources of
Sources [] -> updatePosChar pos c
Sources ((_,t):(pos',_):_)
| T.null t -> pos'
Sources _ ->
case c of
'\n' -> incSourceLine (setSourceColumn pos 1) 1
'\t' -> incSourceColumn pos (4 - ((sourceColumn pos - 1) `mod` 4))
_ -> incSourceColumn pos 1
-- | Get name of first source in 'Sources'.
initialSourceName :: Sources -> FilePath
initialSourceName (Sources []) = ""
initialSourceName (Sources ((pos,_):_)) = sourceName pos
-- | Add some text to the beginning of the input sources.
-- This simplifies code that expands macros.
addToInput :: Monad m => Text -> ParsecT Sources u m ()
addToInput t = do
Sources xs <- P.getInput
case xs of
[] -> P.setInput $ Sources [(initialPos "",t)]
(pos,t'):rest -> P.setInput $ Sources ((pos, t <> t'):rest)
-- We need to redefine the parsers in Text.Parsec.Char so that they
-- update source positions properly from the Sources stream.
satisfy :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> (Char -> Bool) -> ParsecT s u m Char
satisfy f = P.tokenPrim show updateSourcePos matcher
where
matcher c = if f c then Just c else Nothing
oneOf :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> [Char] -> ParsecT s u m Char
oneOf cs = satisfy (`elem` cs)
noneOf :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> [Char] -> ParsecT s u m Char
noneOf cs = satisfy (`notElem` cs)
anyChar :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
anyChar = satisfy (const True)
char :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> Char -> ParsecT s u m Char
char c = satisfy (== c)
string :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> [Char] -> ParsecT s u m [Char]
string = mapM char
newline :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
newline = satisfy (== '\n')
space :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
space = satisfy isSpace
spaces :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m ()
spaces = P.skipMany space P.<?> "white space"
letter :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
letter = satisfy isLetter
alphaNum :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
alphaNum = satisfy isAlphaNum
digit :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
digit = satisfy isDigit
hexDigit :: (Monad m, Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s u m Char
hexDigit = satisfy isHexDigit
|
