Find file
Fetching contributors…
Cannot retrieve contributors at this time
78 lines (62 sloc) 2.82 KB
{-# LANGUAGE TemplateHaskell, QuasiQuotes, ViewPatterns #-}
module Demo where
import Text.Regex.PCRE.Rex
import qualified Data.ByteString.Char8 as B
import Data.Maybe (catMaybes, isJust)
main =
do demonstrate "math" math "1 + 3"
demonstrate "math" math "3 * 2 + 100"
demonstrate "math" math "20 / 3 + 100 * 2"
demonstrate "peano" peano "S Z"
demonstrate "peano" peano "S S S S Z"
demonstrate "peano" peano "S S Z"
demonstrate "parsePair" parsePair "<-1, 3>"
demonstrate "parsePair" parsePair "<-4,3b0>"
demonstrate "parsePair" parsePair "< a, -30 >"
demonstrate "parsePair" parsePair "< a, other>"
demonstrate "parsePair'" parsePair' "<-1, 3>"
demonstrate "parseDate" parseDate "1993.8.10"
demonstrate "parseDate" parseDate "1993.08.10"
demonstrate "parseDate" parseDate "2003.02.28"
demonstrate "parseDate" parseDate "2004.02.28"
demonstrate "parseDate" parseDate "2003.02.27"
demonstrate "disjunct" disjunct "a"
demonstrate "disjunct" disjunct "ab"
demonstrate "disjunct" disjunct "abc"
print $ "btest: " ++ show btest
demonstrate n f input = putStrLn $ n ++ " \"" ++ input ++ "\" == " ++ show (f input)
math x = mathl x 0
mathl [] x = x
mathl [rex|^ \s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s y
mathl [rex|^\+\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x + y
mathl [rex|^ -\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x - y
mathl [rex|^\*\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x * y
mathl [rex|^ /\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x / y
mathl str x = error str
peano :: String -> Maybe Int
peano = [rex|^(?{ length . filter (=='S') } \s* (?:S\s+)*Z)\s*$|]
parsePair :: String -> Maybe (String, String)
parsePair = [rex|^<\s* (?{ }[^\s,>]+) \s*,\s* (?{ }[^\s,>]+) \s*>$|]
parsePair' :: String -> Maybe (Int, Int)
parsePair' = [rex|^<\s* (?{ }[^\s,>]+) \s*,\s* (?{ }[^\s,>]+) \s*>$|]
where
rexView = read
-- From http://www.regular-expressions.info/dates.html
parseDate :: String -> Maybe (Int, Int, Int)
parseDate [rex|^(?{ read -> y }(?:19|20)\d\d)[- /.]
(?{ read -> m }0[1-9]|1[012])[- /.]
(?{ read -> d }0[1-9]|[12][0-9]|3[01])$|]
| (d > 30 && (m `elem` [4, 6, 9, 11]))
|| (m == 2 &&
(d ==29 && not (mod y 4 == 0 && (mod y 100 /= 0 || mod y 400 == 0)))
|| (d > 29)) = Nothing
| otherwise = Just (y, m, d)
parseDate _ = Nothing
onNull a f [] = a
onNull _ f xs = f xs
nonNull = onNull Nothing
disjunct [rex| ^(?:(?{nonNull $ Just . head -> a} .)
| (?{nonNull $ Just . head -> b} ..)
| (?{nonNull $ Just . last -> c} ...))$|] =
head $ catMaybes [a, b, c]
btest = [brex|(?{}hello)|] (B.pack "hello") == Just (B.pack "hello")