summaryrefslogtreecommitdiff
path: root/src/Thue/Parser.hs
blob: 9c52d6ab8b851c3315ca8ed0b2f29477424c47e5 (plain)
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
module Thue.Parser (
	ThueProgram(..),
	ThueRule(..),
	ThueState,
	ThueChar(..),

	ThueVersion(..),

	parseThue,
	parseThue2a,
	
	tCh,
	tLit,
	tStr,
	tLitStr,
	fromThueState
	) where

import Control.Applicative( some )
import Text.ParserCombinators.Parsec




data ThueProgram = ThueProgram  { thueRules :: [ThueRule]
                                , thueInitialState :: ThueState
                                , thueVersion :: ThueVersion }
    deriving (Show, Eq)


data ThueRule  =  ThueRule  { original :: ThueState
                            , replacement :: ThueState }
    deriving (Show, Eq)


type ThueState = [ThueChar]


data ThueChar = TChar { tChar :: Char }
              | TLit { tChar :: Char }
    deriving (Show, Eq)


data ThueVersion = Ver1 | Ver2a
    deriving (Show, Eq)




parseThue :: String -> Either ParseError ThueProgram
parseThue = parse (thue Ver1) "error"



parseThue2a :: String -> Either ParseError ThueProgram
parseThue2a = parse (thue Ver2a) "error"



tCh :: Char -> ThueChar
tCh = TChar

tLit :: Char -> ThueChar
tLit = TLit

tStr :: String -> ThueState
tStr = map TChar

tLitStr :: String -> ThueState
tLitStr = map TLit

fromThueState :: ThueState -> String
fromThueState = map tChar




thue ver = do
	many blankLine
	rs <- many (rule ver)
	separatorLine
	i <- initialState ver
	eof
	return (ThueProgram rs i ver)


rule ver = do
	o <- ruleState ver
	separator
	r <- state ver
	eol
	many blankLine
	return (ThueRule o r)


blankLine = many (oneOf " \t") >> eol


separatorLine = separator >> eol
separator  =  string "::="
          <?> "rule separator"


initialState ver = do
	s <- (state ver) `sepEndBy` eol
	return (concat s)


ruleState Ver2a = some ruleStatePart >>= return . concat
ruleState Ver1 = some (ruleStateChar Ver1) >>= return . tStr


ruleStatePart =
	(try (some (ruleStateChar Ver2a) >>= return . tStr))
	<|> quoteString
	<?> "thue state"


ruleStateChar Ver2a = try escapeChar <|> (noneOf "\\\n\r\":") <|> colon <?> "state character"
ruleStateChar Ver1 = (noneOf "\n\r:") <|> colon <?> "state character"
colon = try (char ':' >> notFollowedBy (string ":=") >> return ':')


state Ver2a = many statePart >>= return . concat
state Ver1 = many (stateChar Ver1) >>= return . tStr


statePart =
	(try (some (stateChar Ver2a) >>= return . tStr))
	<|> quoteString
	<?> "thue state"


stateChar Ver2a = (try escapeChar) <|> (noneOf "\\\n\r\"") <?> "state character"
stateChar Ver1 = (noneOf "\n\r") <?> "state character"


escapeChar = char '\\' >> charCode
charCode =
	(char 'n' >> return '\n')
	<|> (char '"')
	<|> (char 'E' >> char 'O' >> char 'T' >> return '\EOT')
	<|> (char ':')
	<|> (char 'r' >> return '\r')
	<|> (char '\\')


quoteString = do
	char '"'
	str <- some (stateChar Ver2a)
	char '"'
	return (tLitStr str)


eol  =  try (string "\r\n")
    <|> try (string "\n\r")
    <|> try (string "\r")
    <|> try (string "\n")
    <?> "end of line"