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
|
{- Copyright © 2015 Benjamin Barenblat
This program is free software: you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this program. If not, see <http://www.gnu.org/licenses/>. -}
{- Grammar:
S → ε | TEXT | TEXT block S | block S
block → << TEXT >>= code
code → @ | TEXT @ | TEXT reference code | reference code
reference → << TEXT >>
TEXT -> any sequence of one or more Unicode code points -}
module Fragment ( Fragment(..)
, CodeOrReference(..)
, parseFragments) where
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.Applicative ((<$>), (<*>))
import Control.Monad (void)
import Text.Parsec
import Text.Parsec.String
data Fragment = Documentation String
| BlockCode String [CodeOrReference]
deriving (Eq, Show, Data, Typeable, Generic)
data CodeOrReference = Code String
| Reference String
deriving (Eq, Show, Data, Typeable, Generic)
parseFragments :: FilePath -> String -> Either String [Fragment]
parseFragments path input =
case parse literateFile path input of
Right result -> Right result
Left err -> Left $ show err
literateFile :: Parser [Fragment]
literateFile = (:) <$> blockCode <*> literateFile
<|> do body <- try $ manyTill anyChar (lookAhead blockCode)
block <- blockCode
rest <- literateFile
return $ Documentation body : block : rest
<|> (:[]) . Documentation <$> manyTill anyChar eof
blockCode :: Parser Fragment
blockCode = do
void $ try $ string "<<"
name <- many1Till (noneOf "\r\n") (try $ string ">>=")
body <- code
return $ BlockCode name body
data CodeTerminator = AtSign
| BeginReference
deriving (Eq, Show, Data, Typeable, Generic)
atSign :: Parser CodeTerminator
atSign = char '@' >> return AtSign
beginReference :: Parser CodeTerminator
beginReference = lookAhead reference >> return BeginReference
code :: Parser [CodeOrReference]
code = (:) <$> reference <*> code
<|> do (body, exitChar) <- manyTill' anyChar (atSign <|> beginReference)
case exitChar of
AtSign -> return [Code body]
BeginReference -> do
ref <- option [] $ (:[]) <$> reference
rest <- code
return $ Code body : ref ++ rest
reference :: Parser CodeOrReference
reference = do
void $ try $ string "<<"
name <- many1Till anyChar (try $ string ">>")
return $ Reference name
manyTill' :: Stream s m t
=> ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill' p end = scan
where scan = do exit <- end
return ([], exit)
<|>
do x <- p
(xs, exit) <- scan
return (x:xs, exit)
many1Till :: Stream s m t
=> ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
many1Till p end = (:) <$> p <*> manyTill p end
|
