2020-07-04 15:45:29 +03:00
|
|
|
module Main
|
|
|
|
|
|
|
|
import Control.Monad.Identity
|
2020-07-05 11:22:23 +03:00
|
|
|
import Control.Monad.Trans
|
2020-07-04 15:45:29 +03:00
|
|
|
|
2020-07-05 15:22:49 +03:00
|
|
|
import Data.Maybe
|
2020-11-23 21:12:39 +03:00
|
|
|
import Data.Vect
|
2020-07-05 15:22:49 +03:00
|
|
|
import Data.String.Parser
|
|
|
|
|
2020-07-05 11:22:23 +03:00
|
|
|
%default partial
|
2020-07-05 17:39:34 +03:00
|
|
|
-- Build this program with '-p contrib'
|
2020-07-04 15:45:29 +03:00
|
|
|
|
2020-07-05 17:39:34 +03:00
|
|
|
showRes : Show a => Either String (a, Int) -> IO ()
|
2020-07-05 15:22:49 +03:00
|
|
|
showRes res = case res of
|
|
|
|
Left err => putStrLn err
|
2020-07-05 17:39:34 +03:00
|
|
|
Right (xs, rem) => printLn xs
|
2020-07-05 15:22:49 +03:00
|
|
|
|
2020-07-05 14:26:21 +03:00
|
|
|
-- test lifting
|
2020-07-05 11:22:23 +03:00
|
|
|
parseStuff : ParseT IO ()
|
|
|
|
parseStuff = do a <- string "abc"
|
|
|
|
lift $ putStrLn "hiya"
|
|
|
|
b <- string "def"
|
|
|
|
pure ()
|
|
|
|
|
2020-07-05 14:26:21 +03:00
|
|
|
-- test a parsing from a pure function
|
2020-07-05 17:39:34 +03:00
|
|
|
pureParsing : String -> Either String ((List Char), Int)
|
2020-07-05 11:27:42 +03:00
|
|
|
pureParsing str = parse (many (satisfy isDigit)) str
|
2020-07-05 11:22:23 +03:00
|
|
|
|
2020-07-05 15:22:49 +03:00
|
|
|
|
2020-07-05 17:39:34 +03:00
|
|
|
-- test option
|
2020-07-05 15:22:49 +03:00
|
|
|
optParser : ParseT IO String
|
|
|
|
optParser = do res <- option "" (takeWhile isDigit)
|
2021-02-24 14:07:16 +03:00
|
|
|
ignore $ string "def"
|
2020-07-05 15:22:49 +03:00
|
|
|
pure $ res
|
2020-07-05 14:26:21 +03:00
|
|
|
|
2020-07-05 17:39:34 +03:00
|
|
|
-- test optional
|
2020-07-05 17:00:29 +03:00
|
|
|
maybeParser : ParseT IO Bool
|
|
|
|
maybeParser = do res <- optional (string "abc")
|
2021-02-24 14:07:16 +03:00
|
|
|
ignore $ string "def"
|
2020-07-05 17:00:29 +03:00
|
|
|
pure $ isJust res
|
|
|
|
|
2020-07-04 15:45:29 +03:00
|
|
|
main : IO ()
|
|
|
|
main = do
|
2020-07-05 11:22:23 +03:00
|
|
|
res <- parseT parseStuff "abcdef"
|
2020-07-05 17:39:34 +03:00
|
|
|
res <- parseT (string "hi") "hiyaaaaaa"
|
2020-07-04 15:45:29 +03:00
|
|
|
case res of
|
|
|
|
Left err => putStrLn "NOOOOOOO!"
|
2020-11-23 21:12:39 +03:00
|
|
|
Right (_, i) => printLn i
|
2020-07-05 17:39:34 +03:00
|
|
|
bad <- parseT (satisfy isDigit) "a"
|
|
|
|
showRes bad
|
2020-07-06 15:13:56 +03:00
|
|
|
bad2 <- parseT (string "good" <?> "Not good") "bad bad bad"
|
|
|
|
showRes bad2
|
2020-07-05 17:39:34 +03:00
|
|
|
digs <- parseT (many (satisfy isDigit)) "766775"
|
2020-07-05 14:26:21 +03:00
|
|
|
showRes digs
|
|
|
|
showRes $ pureParsing "63553"
|
|
|
|
s <- parseT (takeWhile isDigit) "887abc8993"
|
|
|
|
showRes s
|
2020-07-05 15:22:49 +03:00
|
|
|
res <- parseT optParser "123def"
|
|
|
|
showRes res
|
|
|
|
res <- parseT optParser "def"
|
|
|
|
showRes res
|
2020-07-05 17:00:29 +03:00
|
|
|
res <- parseT maybeParser "abcdef"
|
|
|
|
showRes res
|
|
|
|
res <- parseT maybeParser "def"
|
|
|
|
showRes res
|
2020-11-23 21:12:39 +03:00
|
|
|
res <- parseT (commaSep alphaNum) "a,1,b,2"
|
|
|
|
showRes res
|
|
|
|
res <- parseT (ntimes 4 letter) "abcd"
|
|
|
|
showRes res
|
|
|
|
res <- parseT (requireFailure letter) "1"
|
|
|
|
showRes res
|
|
|
|
res <- parseT (requireFailure letter) "a" -- Should error
|
|
|
|
showRes res
|
|
|
|
pure ()
|