aboutsummaryrefslogtreecommitdiff
path: root/Haskell-book/24/ParserExercises
diff options
context:
space:
mode:
Diffstat (limited to 'Haskell-book/24/ParserExercises')
-rw-r--r--Haskell-book/24/ParserExercises/.gitignore3
-rw-r--r--Haskell-book/24/ParserExercises/Setup.hs2
-rw-r--r--Haskell-book/24/ParserExercises/package.yaml38
-rw-r--r--Haskell-book/24/ParserExercises/src/Base10Integer.hs52
-rw-r--r--Haskell-book/24/ParserExercises/src/IPAddress.hs260
-rw-r--r--Haskell-book/24/ParserExercises/src/LogParser.hs83
-rw-r--r--Haskell-book/24/ParserExercises/src/PhoneNumber.hs28
-rw-r--r--Haskell-book/24/ParserExercises/src/SemVer.hs51
-rw-r--r--Haskell-book/24/ParserExercises/stack.yaml66
-rw-r--r--Haskell-book/24/ParserExercises/test/LogTest/Main.hs14
-rw-r--r--Haskell-book/24/ParserExercises/test/Spec/Main.hs107
11 files changed, 704 insertions, 0 deletions
diff --git a/Haskell-book/24/ParserExercises/.gitignore b/Haskell-book/24/ParserExercises/.gitignore
new file mode 100644
index 0000000..1918f96
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+ParserExercises.cabal
+*~ \ No newline at end of file
diff --git a/Haskell-book/24/ParserExercises/Setup.hs b/Haskell-book/24/ParserExercises/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/24/ParserExercises/package.yaml b/Haskell-book/24/ParserExercises/package.yaml
new file mode 100644
index 0000000..8740046
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/package.yaml
@@ -0,0 +1,38 @@
+name: ParserExercises
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- parsec
+- trifecta
+- QuickCheck
+- time
+- containers
+
+library:
+ source-dirs: src
+
+tests:
+ ParserExercises-test:
+ main: Main.hs
+ source-dirs: test/Spec
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ParserExercises
+ - hspec
+
+ Log-test:
+ main: Main.hs
+ source-dirs: test/LogTest
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ParserExercises
diff --git a/Haskell-book/24/ParserExercises/src/Base10Integer.hs b/Haskell-book/24/ParserExercises/src/Base10Integer.hs
new file mode 100644
index 0000000..4e8ee3a
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/Base10Integer.hs
@@ -0,0 +1,52 @@
+module Base10Integer where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 2. Write a parser for positive integer values. Don't reuse the preexisting
+-- digit or integer functions, but you can use the rest of the libraries we've
+-- shown you so far. You are not expected to write a parsing library from
+-- scratch.
+--
+-- Hint: Assume you're parsing base-10 numbers. Use arithmetic as a cheap
+-- "accumulator" for your final number as you parse each digit left-to-right.
+
+parseDigit :: Parser Char
+parseDigit = (char '0')
+ <|> (char '1')
+ <|> (char '2')
+ <|> (char '3')
+ <|> (char '4')
+ <|> (char '5')
+ <|> (char '6')
+ <|> (char '7')
+ <|> (char '8')
+ <|> (char '9')
+
+charToDigit :: Char -> Integer
+charToDigit c = case c of
+ '0' -> 0
+ '1' -> 1
+ '2' -> 2
+ '3' -> 3
+ '4' -> 4
+ '5' -> 5
+ '6' -> 6
+ '7' -> 7
+ '8' -> 8
+ '9' -> 9
+
+base10Integer :: Parser Integer
+base10Integer = do
+ number <- some parseDigit
+ let n = foldl (\acc x -> (acc * 10) + (charToDigit x)) 0 number
+ return n
+
+-- 3. Extend the parser your wrote to handle negative and positive integers.
+-- Try writing a new parser in terms of the one you already have to do this.
+base10Integer' :: Parser Integer
+base10Integer' = do
+ negative <- (char '-' >> (return negate)) <|> (return id)
+ number <- some parseDigit
+ let n = foldl (\acc x -> (acc * 10) + (charToDigit x)) 0 number
+ return $ negative n
diff --git a/Haskell-book/24/ParserExercises/src/IPAddress.hs b/Haskell-book/24/ParserExercises/src/IPAddress.hs
new file mode 100644
index 0000000..e6a7102
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/IPAddress.hs
@@ -0,0 +1,260 @@
+module IPAddress where
+
+import Numeric
+import Control.Monad (join)
+import Control.Applicative
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Map (lookup, Map(..), fromList)
+import Data.Word
+import Data.Bits
+import Text.Trifecta
+
+-- 6. Write a parser for IPv4 addresses.
+
+data IPAddress = IPAddress Word32 deriving (Eq, Ord)
+
+parseIP4 :: Parser IPAddress
+parseIP4 = do
+ p1 <- natural
+ _ <- char '.'
+ p2 <- natural
+ _ <- char '.'
+ p3 <- natural
+ _ <- char '.'
+ p4 <- natural
+ return $ IPAddress $ fromIntegral $ xor (xor (xor (shift p1 24) (shift p2 16)) (shift p3 8)) p4
+
+-- A 32-bit word is a 32-bit unsigned int. Lowest value is 0 rahter than being
+-- capable of representing negative numbers, but the highest possible value in
+-- the same number of bits is twice as high.
+--
+-- Word32 is an appropriate and compact way to represent IPv4 addresses. You
+-- are expected to figure out not only how to parse the typical IP address
+-- format, but how IP addresses work numerically insofar as is required to
+-- write a working parser. This will require using a search engine unless you
+-- have an appropriate book on internet networking handy.
+
+-- 7. Same as before, but IPv6.
+
+data IPAddress6 = IPAddress6 Word64 Word64 deriving (Eq, Ord)
+
+-- One of the trickier parts about IPv6 will be full vs. collapsed
+-- addresses and the abbrevations. See this Q&A thread 13 about
+-- IPv6 abbreviations for more.
+
+
+newtype IPV6Normed = IPV6Normed String
+ deriving (Eq, Ord, Show)
+
+newtype IPV6Str = IPV6Str String
+ deriving (Eq, Ord, Show)
+
+spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
+spanList _ [] = ([],[])
+spanList func list@(x:xs) =
+ if func list
+ then (x:ys,zs)
+ else ([],list)
+ where (ys,zs) = spanList func xs
+
+breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
+breakList func = spanList (not . func)
+
+split' :: Eq a => [a] -> [a] -> [[a]]
+split' _ [] = []
+split' delim str =
+ let (firstline, remainder) = breakList (isPrefixOf delim) str
+ in
+ firstline : case remainder of
+ [] -> []
+ x -> if x == delim
+ then [] : []
+ else split' delim
+ (drop (length delim) x)
+
+join :: [a] -> [[a]] -> [a]
+join delim l = concat (intersperse delim l)
+
+replace :: Eq a => [a] -> [a] -> [a] -> [a]
+replace old new l = IPAddress.join new . split' old $ l
+
+split :: Eq a => a -> [a] -> [[a]]
+split d [] = []
+split d s = x : split d (drop 1 y)
+ where
+ (x, y) = Data.List.span (/= d) s
+
+twoRaised16Exp :: [Integer]
+twoRaised16Exp = fmap ((2 ^ 16) ^) [0,1 ..]
+
+validHexChars :: String
+validHexChars = "0123456789abcdefABCDEF"
+
+validHexCharsLowerOnly :: String
+validHexCharsLowerOnly = "0123456789abcdef"
+
+buildExpanded0s :: Int -> String
+buildExpanded0s i = intersperse ':' (take i (repeat '0'))
+
+ipv6NormedToIPAddress6 :: IPV6Normed -> IPAddress6
+ipv6NormedToIPAddress6 (IPV6Normed str) = IPAddress6 quotient remainder
+ where
+ asSegs = split ':' str
+ zippedWithExp = zip (reverse asSegs) twoRaised16Exp
+ asInteger = foldr (\(s, exp) acc -> hexToDec s * exp + acc) 0 zippedWithExp
+ (q, r) = quotRem asInteger word64Max
+ quotient = fromIntegral q
+ remainder = fromIntegral r
+
+hexToDec :: String -> Integer
+hexToDec s = toInteger asInt
+ where
+ asInt = baseNToDec 16 (\c -> fromMaybe 0 (Data.Map.lookup (toLower c) hexCharToValue)) s
+
+baseNToDec :: Num i => i -> (a -> i) -> [a] -> i
+baseNToDec base toInt = foldl' (\acc n -> base * acc + toInt n ) 0
+
+hexCharToValue :: Map Char Int
+hexCharToValue = Data.Map.fromList $ zip validHexCharsLowerOnly [0 ..]
+
+word64Max :: Integer
+word64Max = toInteger (maxBound :: Word64)
+
+mkIPV6Normed :: String -> Either String IPV6Normed
+mkIPV6Normed origS = result
+ where
+ expand s
+ | s == "::" = IPV6Normed $ buildExpanded0s 8
+ | isPrefixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 2
+ filler = buildExpanded0s expandCnt ++ ":"
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | isSuffixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 1
+ filler = ':' : buildExpanded0s expandCnt
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | isInfixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 1
+ filler = ':' : buildExpanded0s expandCnt ++ ":"
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | otherwise = IPV6Normed s
+ expanded = expand origS
+ IPV6Normed expandedStr = expanded
+ result = if length (split ':' expandedStr) == 8
+ then Right expanded
+ else Left "invalid sections"
+
+parseIPV6Section :: Parser String
+parseIPV6Section = do
+ mL <- optional (try $ string "::" <|> string ":")
+ seq <- some (oneOf validHexChars)
+ mR <- optional (try $ string "::" <|> string ":")
+ let lowered = map toLower seq
+ l = fromMaybe "" mL
+ r = fromMaybe "" mR
+ return $ l ++ lowered ++ r
+
+parseIPV6Str :: Parser IPV6Str
+parseIPV6Str = do
+ s <- (try $ (fmap (: []) (string "::" <* eof))) <|> manyTill parseIPV6Section
+ eof
+ if length s < 1
+ then fail "Did not find valid sections"
+ else return $ IPV6Str $ Control.Monad.join s
+
+parseIPV6Normed :: Parser IPV6Normed
+parseIPV6Normed = do
+ str <- parseIPV6Str
+ let IPV6Str (s) = str
+ full = mkIPV6Normed s
+ case full of
+ Left err -> fail err
+ Right fullstr -> return fullstr
+
+parseIP6 :: Parser IPAddress6
+parseIP6 = do
+ normed <- parseIPV6Normed
+ return $ ipv6NormedToIPAddress6 normed
+
+-- 8. Remove the derived Show instances from the IPAddress/IPAddress6
+-- types, and write your own Show instance for each type that renders in the
+-- typical textual format appropriate to each.
+
+ipAddressToIPV4DotFields :: IPAddress -> [Integer]
+ipAddressToIPV4DotFields (IPAddress word) = repr
+ where
+ asInteger = toInteger word
+ repr = decToBaseN asInteger 0 [0 .. 255]
+
+instance Show IPAddress where
+ show ip = Control.Monad.join $ intersperse "." asStrings
+ where
+ repr = ipAddressToIPV4DotFields ip
+ asStrings = fmap show repr
+
+ipAddress6toInteger :: IPAddress6 -> Integer
+ipAddress6toInteger (IPAddress6 q r) = toInteger q * word64Max + toInteger r
+
+iPAddress6ToIPV6Normed :: IPAddress6 -> IPV6Normed
+iPAddress6ToIPV6Normed ip = IPV6Normed s
+ where
+ asInteger = ipAddress6toInteger ip
+ chopped = integerToChoppedUp asInteger
+ ss = fmap integerToHexString chopped
+ fillCnt = 8 - length ss
+ filled = (take fillCnt (repeat "0")) ++ ss
+ s = Control.Monad.join $ intersperse ":" filled
+
+instance Show IPAddress6 where
+ show ip = normed
+ where IPV6Normed normed = iPAddress6ToIPV6Normed ip
+
+-- 9. Write a function that converts between IPAddress and IPAddress6.
+
+decToBaseN :: Integral a => a -> b -> [b] -> [b]
+decToBaseN i zero digits = if base == 0
+ then []
+ else go i []
+ where
+ base = fromIntegral $ length digits
+ go 0 [] = [zero]
+ go 0 acc = acc
+ go curr acc =
+ let (q, r) = quotRem curr base
+ in go q ((digits !! fromIntegral r) : acc)
+
+integerToHexString :: Integer -> String
+integerToHexString i = decToBaseN i '0' validHexCharsLowerOnly
+
+integerToChoppedUp :: Integer -> [Integer]
+integerToChoppedUp i = go i []
+ where
+ go 0 [] = [0]
+ go 0 acc = acc
+ go curr acc =
+ let (q, r) = quotRem curr (2 ^ 16)
+ in go q (r : acc)
+
+ipV4ToIpV6Normed :: IPAddress -> IPV6Normed
+ipV4ToIpV6Normed (IPAddress word) = normed
+ where
+ asInteger = toInteger word
+ chopped = integerToChoppedUp asInteger
+ ss = fmap integerToHexString chopped
+ fillCnt = 8 - length ss - 1
+ -- - ffff signifies an ip4 to ip6 conversion
+ -- (http://www.tcpipguide.com/free/t_IPv6IPv4AddressEmbedding-2.htm)
+ filled = (take fillCnt $ repeat "0") ++ ["ffff"] ++ ss
+ s = Control.Monad.join $ intersperse ":" filled
+ normed = IPV6Normed s
+
+ipV4ToIpV6 :: IPAddress -> IPAddress6
+ipV4ToIpV6 ip = ipv6
+ where
+ normed = ipV4ToIpV6Normed ip
+ ipv6 = ipv6NormedToIPAddress6 normed
diff --git a/Haskell-book/24/ParserExercises/src/LogParser.hs b/Haskell-book/24/ParserExercises/src/LogParser.hs
new file mode 100644
index 0000000..480498d
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/LogParser.hs
@@ -0,0 +1,83 @@
+module LogParser where
+
+import Control.Applicative
+import Data.Time
+import Test.QuickCheck
+import Text.Trifecta
+
+-- 5. Write a parser for a log file format and sum the time spent in
+-- each activity. Additionally, provide an alternative aggregation
+-- of the data that provides average time spent per activity per day.
+-- The format supports the use of comments which your parser
+-- will have to ignore. The # characters followed by a date mark
+-- the beginning of a particular day.
+--
+-- You are to derive a reasonable datatype for representing this
+-- data yourself. For bonus points, make this bi-directional by
+-- making a Show representation for the datatype which matches
+-- the format you are parsing. Then write a generator for this data
+-- using QuickCheck’s Gen and see if you can break your parser
+-- with QuickCheck.
+
+data Statement = Statement TimeOfDay String deriving Eq
+data LogEntry = LogEntry Day [Statement] deriving Eq
+newtype Log = Log { getLog :: [LogEntry] }
+
+instance Show Statement where
+ show (Statement x y) = (formatTime defaultTimeLocale "%R" x) ++ " " ++ y
+
+instance Show LogEntry where
+ show (LogEntry x y) = "# " ++ (show x) ++ "\n"
+ ++ (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)
+
+instance Show Log where
+ show (Log y) = (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)
+
+instance Arbitrary Statement where
+ arbitrary = do
+ h <- choose (0, 23)
+ m <- choose (0, 59)
+ text <- listOf1 $ elements ['.'..'~']
+ return $ Statement (TimeOfDay h m 0) text
+
+instance Arbitrary LogEntry where
+ arbitrary = do
+ day <- arbitrary
+ statements <- arbitrary
+ return $ LogEntry (ModifiedJulianDay day) statements
+
+skipEOL :: Parser ()
+skipEOL = skipMany (oneOf "\n")
+
+skipComments :: Parser ()
+skipComments =
+ skipMany (do _ <- char '-'
+ _ <- char '-'
+ skipMany (noneOf "\n")
+ skipEOL)
+
+parseStatement :: Parser Statement
+parseStatement = do
+ h <- integer
+ _ <- char ':'
+ m <- integer
+ text <- manyTill anyChar (try (string "--") <|> (string "\n") <|> (eof >> return ""))
+ skipComments
+ skipEOL
+ return $ Statement (TimeOfDay (fromIntegral h) (fromIntegral m) 0) text
+
+parseLogEntry :: Parser LogEntry
+parseLogEntry = do
+ _ <- string "# "
+ y <- integer
+ _ <- char '-'
+ m <- integer
+ _ <- char '-'
+ d <- integer
+ skipComments
+ skipEOL
+ statements <- many parseStatement
+ return $ LogEntry (fromGregorian (fromIntegral y) (fromIntegral m) (fromIntegral d)) statements
+
+parseLog :: Parser Log
+parseLog = Log <$> many parseLogEntry
diff --git a/Haskell-book/24/ParserExercises/src/PhoneNumber.hs b/Haskell-book/24/ParserExercises/src/PhoneNumber.hs
new file mode 100644
index 0000000..dad75a7
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/PhoneNumber.hs
@@ -0,0 +1,28 @@
+module PhoneNumber where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 4. Write a parser for US/Canada phone numbers with varying formats.
+-- Cf. Wikipeida's article on "National conventions for writing telephone
+-- numbers". You are encouraged to adapt the exercise to your locality's
+-- conventions if they are not part of the NNAP scheme.
+
+-- aka area code
+type NumberingPlanArea = Int
+type Exchange = Int
+type LineNumber = Int
+
+data PhoneNumber = PhoneNumber NumberingPlanArea Exchange LineNumber
+ deriving (Eq, Show)
+
+parsePhone :: Parser PhoneNumber
+parsePhone = do
+ _ <- optional ((try $ char '(') <|> (try (char '1' >> char '-')))
+ area <- count 3 digit
+ _ <- optional $ (try $ char ')')
+ _ <- optional $ (try $ char ' ') <|> (try $ char '-')
+ exchange <- count 3 digit
+ _ <- optional $ (char ' ') <|> (char '-')
+ lineNumber <- decimal
+ return $ PhoneNumber (read area) (read exchange) (fromIntegral lineNumber)
diff --git a/Haskell-book/24/ParserExercises/src/SemVer.hs b/Haskell-book/24/ParserExercises/src/SemVer.hs
new file mode 100644
index 0000000..47b49ab
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/SemVer.hs
@@ -0,0 +1,51 @@
+module SemVer where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 1. Write a parser for semantic versions as defined by http://semver.org/.
+-- After making a working parser, write an Ord instance for the SemVer type
+-- that obeys the specification outlined on the SemVer website.
+
+-- Relevant to precedence/ordering,
+-- cannot sort numbers like strings.
+data NumberOrString = NOSS String
+ | NOSI Integer
+ deriving (Eq, Show)
+
+type Major = Integer
+type Minor = Integer
+type Patch = Integer
+type Release = [NumberOrString]
+type Metadata = [NumberOrString]
+
+data SemVer = SemVer Major Minor Patch Release Metadata
+ deriving (Eq, Show)
+
+parseNos :: Parser NumberOrString
+parseNos = do
+ nos <- (NOSI <$> integer)
+ <|> (NOSS <$> some letter)
+ return nos
+
+parseRelease :: Parser [NumberOrString]
+parseRelease = do
+ _ <- char '-'
+ sepBy parseNos (char '.')
+
+parseMetadata :: Parser [NumberOrString]
+parseMetadata = do
+ _ <- char '+'
+ sepBy parseNos (char '.')
+
+parseSemVer :: Parser SemVer
+parseSemVer = do
+ major <- decimal
+ _ <- char '.'
+ minor <- decimal
+ _ <- char '.'
+ patch <- decimal
+ release <- option [] parseRelease
+ metadata <- option [] parseMetadata
+
+ return $ SemVer major minor patch release metadata
diff --git a/Haskell-book/24/ParserExercises/stack.yaml b/Haskell-book/24/ParserExercises/stack.yaml
new file mode 100644
index 0000000..e60ca15
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/stack.yaml
@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.1
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+# git: https://github.com/commercialhaskell/stack.git
+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.6"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor \ No newline at end of file
diff --git a/Haskell-book/24/ParserExercises/test/LogTest/Main.hs b/Haskell-book/24/ParserExercises/test/LogTest/Main.hs
new file mode 100644
index 0000000..7d1d135
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/test/LogTest/Main.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import LogParser
+import Test.QuickCheck
+import Text.Trifecta
+
+maybeSuccess :: Text.Trifecta.Result a -> Maybe a
+maybeSuccess (Text.Trifecta.Success a) = Just a
+maybeSuccess _ = Nothing
+
+main :: IO ()
+main = do
+ quickCheck ((\s -> (maybeSuccess $ parseString parseStatement mempty (show s)) == (Just s)) :: Statement -> Bool)
+ quickCheck ((\s -> (maybeSuccess $ parseString parseLogEntry mempty (show s)) == (Just s)) :: LogEntry -> Bool)
diff --git a/Haskell-book/24/ParserExercises/test/Spec/Main.hs b/Haskell-book/24/ParserExercises/test/Spec/Main.hs
new file mode 100644
index 0000000..23781c6
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/test/Spec/Main.hs
@@ -0,0 +1,107 @@
+import SemVer
+import Base10Integer
+import PhoneNumber
+import IPAddress
+import Test.Hspec
+import Text.Trifecta
+
+maybeSuccess :: Result a -> Maybe a
+maybeSuccess (Success a) = Just a
+maybeSuccess _ = Nothing
+
+parseIP :: String -> Maybe IPAddress
+parseIP s = o
+ where r = parseString parseIP4 mempty s
+ o = case r of
+ (Success o) -> Just o
+ _ -> Nothing
+
+parseIP6' :: String -> Maybe IPAddress6
+parseIP6' s = o
+ where r = parseString parseIP6 mempty s
+ o = case r of
+ (Success o) -> Just o
+ _ -> Nothing
+
+main :: IO ()
+main = hspec $ do
+ describe "parseSemVer" $ do
+ it "parses minimum SemVer" $ do
+ let got = maybeSuccess $ parseString parseSemVer mempty "2.1.1"
+ in got `shouldBe` Just (SemVer 2 1 1 [] [])
+ it "parses release field" $ do
+ let got = maybeSuccess $ parseString parseSemVer mempty "1.0.0-x.7.z.92"
+ expected = Just $ SemVer 1 0 0 [NOSS "x", NOSI 7, NOSS "z", NOSI 92] []
+ in got `shouldBe` expected
+
+ describe "parseDigit" $ do
+ it "parses the first digit of '123'" $ do
+ let got = maybeSuccess $ parseString parseDigit mempty "123"
+ expected = Just '1'
+ in got `shouldBe` expected
+ it "fails on 'abc'" $ do
+ let got = maybeSuccess $ parseString parseDigit mempty "abc"
+ expected = Nothing
+ in got `shouldBe` expected
+
+ describe "base10Integer" $ do
+ it "parses the integer in '123abc'" $ do
+ let got = maybeSuccess $ parseString base10Integer mempty "123abc"
+ expected = Just 123
+ in got `shouldBe` expected
+ it "fails on 'abc'" $ do
+ let got = maybeSuccess $ parseString base10Integer mempty "abc"
+ expected = Nothing
+ in got `shouldBe` expected
+
+ describe "base10Integer'" $ do
+ it "parses negative numbers" $ do
+ let got = maybeSuccess $ parseString base10Integer' mempty "-123abc"
+ expected = Just (-123)
+ in got `shouldBe` expected
+
+ describe "parsePhone" $ do
+ it "parses '123-456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "123-456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '1234567890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "1234567890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '(123) 456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "(123) 456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '1-123-456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "1-123-456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+
+ describe "parseIP4" $ do
+ it "parses localhost" $ do
+ let actual = maybeSuccess $ parseString parseIP4 mempty "127.0.0.1"
+ expected = Just $ IPAddress 2130706433
+ in actual `shouldBe` expected
+
+ describe "parseIP6" $ do
+ it "parses localhost" $ do
+ let actual = maybeSuccess $ parseString parseIP6 mempty "::1"
+ expected = Just $ IPAddress6 0 1
+ in actual `shouldBe` expected
+
+ describe "ipV4ToIpV6" $
+ it "should work" $ do
+ (show . ipV4ToIpV6 <$> parseIP "124.155.107.12") `shouldBe` Just "0:0:0:0:0:ffff:7c9b:6b0c"
+ (show . ipV4ToIpV6 <$> parseIP "192.168.0.1") `shouldBe` Just "0:0:0:0:0:ffff:c0a8:1"
+
+ describe "show" $ do
+ it "should show IPAddress6 properly" $ do
+ (show <$> parseIP6' "ff39:0:0:0:2f2:b3ff:f23d:8d5") `shouldBe` Just "ff39:0:0:0:2f2:b3ff:f23d:8d5"
+ (show <$> parseIP6' "9ff3:EA8::8A:30:2F0C:1F7A") `shouldBe` Just "9ff3:ea8:0:0:8a:30:2f0c:1f7a"
+ (show <$> parseIP6' "::ffff:abc:fed9") `shouldBe` Just "0:0:0:0:0:ffff:abc:fed9"
+
+ it "should show IPAddress properly" $ do
+ (show <$> parseIP "152.163.254.3") `shouldBe` Just "152.163.254.3"
+ (show <$> parseIP "224.165.197.142") `shouldBe` Just "224.165.197.142"
+ (show <$> parseIP "124.155.107.12") `shouldBe` Just "124.155.107.12"