1
0

Add remaining haskell book exercises

This commit is contained in:
2025-12-11 10:28:11 +01:00
parent 3624c712d7
commit 98329e0a3d
221 changed files with 8033 additions and 2 deletions

View File

@@ -0,0 +1,3 @@
.stack-work/
ParserExercises.cabal
*~

View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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 QuickChecks 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

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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"