From 98329e0a3dd4f78b5d815ac3896272ec70904901 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Thu, 11 Dec 2025 10:28:11 +0100 Subject: Add remaining haskell book exercises --- Haskell-book/24/ParserExercises/src/IPAddress.hs | 260 +++++++++++++++++++++++ 1 file changed, 260 insertions(+) create mode 100644 Haskell-book/24/ParserExercises/src/IPAddress.hs (limited to 'Haskell-book/24/ParserExercises/src/IPAddress.hs') 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 -- cgit v1.2.3