151 lines
3 KiB
Idris
151 lines
3 KiB
Idris
module SSG.Djot.Common
|
|
|
|
import SSG.Parser.Core
|
|
import SSG.Parser.Util
|
|
|
|
import Control.Eff
|
|
|
|
--*****************************************
|
|
--* Character Classes and String Escaping *
|
|
--*****************************************
|
|
|
|
-----------------------
|
|
-- Character classes --
|
|
-----------------------
|
|
|
|
-- Class contents
|
|
|
|
export
|
|
punctuationChars : List Char
|
|
punctuationChars =
|
|
[
|
|
'!', '"', '#', '$', '%', '&', '\''
|
|
, '(' , ')' , '*' , '+' , ',' , '-'
|
|
, '.' , '/' , ':' , ';' , '<' , '='
|
|
, '>' , '?' , '@' , '[' , ']' , '^'
|
|
, '_' , '`' , '{' , '|' , '}' , '~'
|
|
]
|
|
|
|
export
|
|
horizontalWhitespaceChars : List Char
|
|
horizontalWhitespaceChars =
|
|
[' ', '\t']
|
|
|
|
export
|
|
verticalWhitespaceChars : List Char
|
|
verticalWhitespaceChars =
|
|
['\n', '\r']
|
|
|
|
-- Class parsers
|
|
|
|
export
|
|
punctuation : PS Char
|
|
punctuation = theseChars punctuationChars
|
|
|
|
--------------
|
|
-- Escaping --
|
|
--------------
|
|
|
|
export
|
|
escapedChar : PS Char
|
|
escapedChar = do
|
|
_ <- thisString "\\"
|
|
oneOfE "Expected an escapable code"
|
|
[ punctuation
|
|
, exactReplace "n" '\n'
|
|
, exactReplace "t" '\t'
|
|
, exactReplace "r" '\r'
|
|
]
|
|
|
|
------------------------------------
|
|
-- Line Qualifying And Whitespace --
|
|
------------------------------------
|
|
|
|
export
|
|
space : PS Char
|
|
space = theseChars horizontalWhitespaceChars
|
|
|
|
export
|
|
spaces : PS Nat
|
|
spaces = do
|
|
xs <- many space
|
|
pure $ length xs
|
|
|
|
export
|
|
nonTerminal : PS Char
|
|
nonTerminal = notTheseChars verticalWhitespaceChars
|
|
|
|
export
|
|
lineEnding : PS String
|
|
lineEnding = theseStrings ["\r\n", "\n", "\r"]
|
|
|
|
export
|
|
terminal : PS ()
|
|
terminal = do
|
|
Nothing <- tryMaybe lineEnding
|
|
| _ => pure ()
|
|
test <- parseEoF
|
|
case test of
|
|
False => throw "Expected line terminal"
|
|
True => pure ()
|
|
|
|
export
|
|
line : PS (List Char)
|
|
line = do
|
|
cs <- many nonTerminal
|
|
_ <- lineEnding
|
|
pure cs
|
|
|
|
export
|
|
isHorizontalWhitespace : Char -> Bool
|
|
isHorizontalWhitespace c = any (== c) horizontalWhitespaceChars
|
|
|
|
export
|
|
blankLine : PS (List Char)
|
|
blankLine = do
|
|
cs <- line
|
|
case all isHorizontalWhitespace cs of
|
|
False => throw "nonblank line"
|
|
True => pure cs
|
|
|
|
export
|
|
blankLineOrEnd : PS ()
|
|
blankLineOrEnd = do
|
|
Nothing <- tryMaybe blankLine
|
|
| Just _ => pure ()
|
|
eof <- parseEoF
|
|
case eof of
|
|
False => throw "Expected newline or end of document"
|
|
True => pure ()
|
|
|
|
export
|
|
blankLines : PS ()
|
|
blankLines = do
|
|
xs <- many blankLine
|
|
if length xs > 0
|
|
then pure ()
|
|
else blankLineOrEnd
|
|
|
|
--*****************************************
|
|
--* Unit Tests *
|
|
--*****************************************
|
|
|
|
-------------------------------
|
|
-- Testing Utility Functions --
|
|
-------------------------------
|
|
|
|
-- Test a parser against a golden value with the supplied input
|
|
export
|
|
golden : Show a => Eq a =>
|
|
(input : String) -> (reference : a) -> (parser : PS a) -> IO Bool
|
|
golden input ref parser = do
|
|
putStrLn "Input: \{input}"
|
|
putStrLn "Expected: \{show ref}"
|
|
let got = runPS parser input
|
|
case got of
|
|
Left err => do
|
|
putStrLn "Failed with error: \{err}"
|
|
pure False
|
|
Right x => do
|
|
putStrLn "Output: \{show x}"
|
|
pure $ x == ref
|