diff --git a/24-parser-combination/24-parser-combination.md b/24-parser-combination/24-parser-combination.md new file mode 100644 index 0000000..41b3092 --- /dev/null +++ b/24-parser-combination/24-parser-combination.md @@ -0,0 +1,29 @@ +# 24 Parser Combination + +## 24.3 Parsing practise + +[src/LearnParsers.hs](./src/LearnParsers.hs) + +## 24.4 Exercise: Unit of Success + +`(>>)` is actually `(*>)` from `Applicative` and `Applicative` also has `(<*)` +which has type `Applicative f => f a -> f b -> f a` So the solution here is: +`integer <* eof` + +## 24.6 Exercise: Try Try + +[src/TryTry.hs](./src/TryTry.hs) + +## 24.11 Chapter Exercises + +1. [src/SemVer.hs](./src/SemVer.hs) +2. [src/PosInt.hs](./src/PosInt.hs) +3. [src/PosInt.hs](./src/PosInt.hs) +4. [src/PhoneNumber.hs](./src/PhoneNumber.hs) +5. [src/ParseLog.hs](./src/ParseLog.hs) +6. [src/IPAddress.hs](./src/IPAddress.hs) +7. [src/IPAddress.hs](./src/IPAddress.hs) +8. [src/IPAddress.hs](./src/IPAddress.hs) +9. [src/IPAddress.hs](./src/IPAddress.hs) +10. Probably not going to finish this at this time. It's a lot of the same + but just a lot more. \ No newline at end of file diff --git a/24-parser-combination/24.11-chapter-exercises.md b/24-parser-combination/24.11-chapter-exercises.md deleted file mode 100644 index 995ebac..0000000 --- a/24-parser-combination/24.11-chapter-exercises.md +++ /dev/null @@ -1,11 +0,0 @@ -# Chapter Exercises -1. see src/SemVer.hs -2. see src/PosInt.hs -3. see src/PosInt.hs -4. see src/PhoneNumber.hs -5. see src/ParseLog.hs -6. see src/IPAddress.hs -7. see src/IPAddress.hs -8. see src/IPAddress.hs -9. see src/IPAddress.hs -10. Not done (yet). \ No newline at end of file diff --git a/24-parser-combination/24.3-parsing-practise.md b/24-parser-combination/24.3-parsing-practise.md deleted file mode 100644 index 09b6116..0000000 --- a/24-parser-combination/24.3-parsing-practise.md +++ /dev/null @@ -1,2 +0,0 @@ -# Exercises: Parsing Practise -see src/LearnParsers.hs \ No newline at end of file diff --git a/24-parser-combination/24.4-unit-of-success.md b/24-parser-combination/24.4-unit-of-success.md deleted file mode 100644 index aa0d175..0000000 --- a/24-parser-combination/24.4-unit-of-success.md +++ /dev/null @@ -1,4 +0,0 @@ -# Exercise: Unit of Success -`(>>)` is actually `(*>)` from `Applicative` and `Applicative` also has `(<*)` which has type `Applicative f => f a -> f b -> f a` - -So the solution here is: `integer <* eof` \ No newline at end of file diff --git a/24-parser-combination/24.6-try-try.md b/24-parser-combination/24.6-try-try.md deleted file mode 100644 index 9077ec0..0000000 --- a/24-parser-combination/24.6-try-try.md +++ /dev/null @@ -1,2 +0,0 @@ -# Exercise: Try Try -see src/TryTry.hs \ No newline at end of file diff --git a/24-parser-combination/src/DOTParser.hs b/24-parser-combination/src/DOTParser.hs new file mode 100644 index 0000000..d385ab9 --- /dev/null +++ b/24-parser-combination/src/DOTParser.hs @@ -0,0 +1,33 @@ +module DOTParser where + +import Text.Trifecta +import Data.Char (toLower, toUpper) +import Control.Applicative ((<|>)) + +iChar :: Char -> Parser Char +iChar c = char (toLower c) <|> char (toUpper c) + +iString :: String -> Parser String +iString s = sequenceA $ fmap iChar s + +data CompassPT = N | NE | E | SE | S | SW | W | NW | C | O deriving (Show, Eq) + +pCompass :: Parser CompassPT +pCompass = + -- North + try (iString "ne" *> pure NE) <|> + try (iString "nw" *> pure NW) <|> + (iString "n" *> pure N) <|> + -- East + (iString "e" *> pure E) <|> + -- South + try (iString "se" *> pure SE) <|> + try (iString "sw" *> pure SW) <|> + (iString "s" *> pure S) <|> + -- West + (iString "w" *> pure W) <|> + -- Others + (iString "c" *> pure C) <|> (string "_" *> pure O) + +newtype ID = ID String deriving (Eq, Show) + diff --git a/24-parser-combination/src/IPAddress.hs b/24-parser-combination/src/IPAddress.hs index 45043ae..6cb286d 100644 --- a/24-parser-combination/src/IPAddress.hs +++ b/24-parser-combination/src/IPAddress.hs @@ -2,21 +2,139 @@ module IPAddress where +import Control.Applicative ((<|>), liftA2, liftA3) import Text.Trifecta hiding (span) -import Data.Word -import Data.Bits -import Data.List (splitAt) -import Numeric (readHex, showHex) -import Control.Monad.State -import Data.Maybe (fromMaybe) --- import Data.List (group, span) -import Data.Either (lefts) --- import qualified Data.Sequence as S +import Data.Word (Word32, Word64) +import Data.Bits (shiftL, shiftR, (.&.)) +import Control.Monad (replicateM) +import Text.Parser.Char (char) +import Data.Char (toLower, ord) +import Data.List (intersperse, span) +import Numeric (showHex) import Test.Hspec -- Exercise 6 data IPAddress = IPAddress Word32 deriving (Eq, Ord) + +parseDecOctet :: CharParsing m => m Integer +parseDecOctet = + fmap read $ case1 <|> case2 <|> case3 <|> case4 <|> case5 + where case1 = try $ sequenceA [char '2', char '5', oneOf "012345"] + case2 = try $ sequenceA [char '2', oneOf "01234", digit] + case3 = try $ sequenceA [char '1', digit, digit] + case4 = try $ sequenceA [oneOf "123456789", digit] + case5 = pure <$> digit + +shiftLFolder :: Int -> [Integer] -> Integer +shiftLFolder i = fst . foldr f (0, 0) + where f a (t, s) = ((a `shiftL` s) + t, s + i) + +parseIPv4Address :: CharParsing m => m IPAddress +parseIPv4Address = + let wDot = char '.' *> parseDecOctet + words = liftA2 (:) parseDecOctet $ replicateM 3 wDot + in IPAddress . fromInteger . shiftLFolder 8 <$> words + +-- Exercise 7 +data IPAddress6 = IPAddress6 Word64 Word64 deriving (Eq, Ord) + +-- From RFC 3986 + +-- IPv6address = 6( h16 ":" ) ls32 +-- / "::" 5( h16 ":" ) ls32 +-- / [ h16 ] "::" 4( h16 ":" ) ls32 +-- / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 +-- / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 +-- / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 +-- / [ *4( h16 ":" ) h16 ] "::" ls32 +-- / [ *5( h16 ":" ) h16 ] "::" h16 +-- / [ *6( h16 ":" ) h16 ] "::" +-- h16 = 1*4HEXDIG +-- ls32 = ( h16 ":" h16 ) / IPv4address + +-- "::" = Cons +data IPv6ParseOption = + NoCons | Cons0 | Cons1 | Cons2 | Cons3 | Cons4 | Cons5 | Cons6 | Cons7 + +-- This is just the representation of the ABNF from the RFC +parseIPv6Address :: Parser IPAddress6 +parseIPv6Address = fmap f $ (try $ parseOption NoCons) + <|> (try $ parseOption Cons0) + <|> (try $ parseOption Cons1) + <|> (try $ parseOption Cons2) + <|> (try $ parseOption Cons3) + <|> (try $ parseOption Cons4) + <|> (try $ parseOption Cons5) + <|> (try $ parseOption Cons6) + <|> parseOption Cons7 + where f = integerToIPv6Address . shiftLFolder 16 + +integerToIPv6Address :: Integer -> IPAddress6 +integerToIPv6Address n = + let [w1, w2] = fmap f [n `shiftR` 64, n] + f = fromInteger . (.&. 0xFFFFFFFFFFFFFFFF) + in IPAddress6 w1 w2 + +parseOption :: IPv6ParseOption -> Parser [Integer] +parseOption o = liftA3 f (parseFirst o) (parseMiddle o) (parseLast o) + where f s1 s2 s3 = s1 ++ s2 ++ s3 + +parseFirst :: IPv6ParseOption -> Parser [Integer] +parseFirst o = case o of + NoCons -> pure [] + Cons0 -> string "::" *> pure [0] + Cons1 -> (try $ lower Cons0) <|> go 0 + Cons2 -> (try $ lower Cons1) <|> go 1 + Cons3 -> (try $ lower Cons2) <|> go 2 + Cons4 -> (try $ lower Cons3) <|> go 3 + Cons5 -> (try $ lower Cons4) <|> go 4 + Cons6 -> (try $ lower Cons5) <|> go 5 + Cons7 -> (try $ lower Cons6) <|> go 6 + where lower o' = liftA2 (++) (parseFirst o') (pure [0]) + go n = liftA2 (++) (rep n) (parseFirst Cons0) + rep n = liftA2 (++) (replicateM n piece) end + piece = parseH16 <* char ':' + end = sequenceA [parseH16] + +parseMiddle :: IPv6ParseOption -> Parser [Integer] +parseMiddle o = case o of + NoCons -> rep 6 + Cons0 -> rep 5 + Cons1 -> rep 4 + Cons2 -> rep 3 + Cons3 -> rep 2 + Cons4 -> rep 1 + otherwise -> pure [] + where rep n = replicateM n (parseH16 <* char ':') + +parseLast :: IPv6ParseOption -> Parser [Integer] +paresLast Cons6 = sequenceA [parseH16] +parseLast Cons7 = pure [] +parseLast _ = parseLs32 + +parseLs32 :: Parser [Integer] +parseLs32 = try case1 <|> case2 + where case1 = sequenceA [parseH16 <* char ':', parseH16] + case2 = toWord16s <$> parseIPv4Address + toWord16s (IPAddress w) = + let w' = toInteger w + in fmap (.&. 0xFFFF) [w' `shiftR` 16, w'] + +parseH16 :: Parser Integer +parseH16 = fmap (shiftLFolder 4) $ try four <|> try three <|> try two <|> one + where four = replicateM 4 parseHexDig + three = replicateM 3 parseHexDig + two = replicateM 2 parseHexDig + one = replicateM 1 parseHexDig + +parseHexDig :: Parser Integer +parseHexDig = d <|> h + where d = read <$> sequenceA [digit] + h = f . toLower <$> oneOf "abcdefABCDEF" + f c = toInteger $ ord c - ord 'a' + 10 + +-- Exercise 8 instance Show IPAddress where show (IPAddress w32) = let n = toInteger w32 @@ -25,36 +143,54 @@ instance Show IPAddress where show ((n `shiftR` 8) .&. 0xFF) ++ "." ++ show (n .&. 0xFF) -parseValidIPByte :: Parser Word8 -parseValidIPByte = do - i <- decimal - let max' = toInteger (maxBound :: Word8) - min' = toInteger (minBound :: Word8) - if i <= max' && i >= min' - then return (fromInteger i) - else unexpected "Invalid byte" - -parseIPv4Address :: Parser IPAddress -parseIPv4Address = do - b1 <- toInteger <$> parseValidIPByte - _ <- char '.' - b2 <- toInteger <$> parseValidIPByte - _ <- char '.' - b3 <- toInteger <$> parseValidIPByte - _ <- char '.' - b4 <- toInteger <$> parseValidIPByte - return $ IPAddress . fromInteger $ (b1 `shiftL` 24) + - (b2 `shiftL` 16) + - (b3 `shiftL` 8) + - b4 +-- RFC 5952 +instance Show IPAddress6 where + show i = concat $ intersperse ":" $ processed + where processed = fmap fix longest + longest = repLongestListOfZeroes $ collapseZeroes asStrings + asStrings = fmap (flip showHex "") (toArray i) + fix x = if length x > 1 then intersperse ':' x else x + +toArray :: IPAddress6 -> [Integer] +toArray (IPAddress6 w1 w2) = go w1 ++ go w2 + where go w = reverse $ take 4 $ f (toInteger w) + f w = w .&. mask : f (w `shiftR` 16) + mask = 0xFFFF + +collapseZeroes :: [String] -> [String] +collapseZeroes [] = [] +collapseZeroes xs = nonZeroes ++ zeroes ++ remainder + where (nonZeroes, rest) = span (/= "0") xs + (zeroes', rest') = span (== "0") rest + zeroes = [concat zeroes'] + remainder = collapseZeroes rest' + +repLongestListOfZeroes :: [String] -> [String] +repLongestListOfZeroes xs = h ++ rep t + where (h, t) = span (p . length) xs + p x = (max' < 2) || (x /= max') + max' = maximum $ fmap length xs + rep [] = [] + rep (x:xs) = "":xs + +-- Exercise 9 +toIPAddress6 :: IPAddress -> IPAddress6 +toIPAddress6 (IPAddress w32) = IPAddress6 0 (fromIntegral w32) +toIPAddress :: IPAddress6 -> Maybe IPAddress +toIPAddress (IPAddress6 w64 w64') + | w64 /= 0 = Nothing + | w64' > (fromIntegral $ (maxBound :: Word32)) = Nothing + | otherwise = Just $ IPAddress (fromIntegral w64') + +-- Tests maybeSuccess :: Result a -> Maybe a maybeSuccess (Success a) = Just a maybeSuccess _ = Nothing - -testByteHelper :: String -> Maybe Word8 -> Expectation -testByteHelper s r = do - let m = parseString parseValidIPByte mempty s +-- IPv4 +testDecOctetHelper :: String -> Maybe Integer -> Expectation +testDecOctetHelper s r = do + let m = parseString parseDecOctet mempty s r' = maybeSuccess m r' `shouldBe` r @@ -64,14 +200,19 @@ testIPv4Helper s r = do r' = maybeSuccess m r' `shouldBe` r -testByte :: IO () -testByte = hspec $ do +testDecOctet :: IO () +testDecOctet = hspec $ do describe "Test parsing of byte" $ do - it "Can parse 0" $ testByteHelper "0" (Just 0) - it "Can parse 255" $ testByteHelper "255" (Just 255) - it "Can't parse 256" $ testByteHelper "256" Nothing - it "Can't parse -1" $ testByteHelper "-1" Nothing - it "Can't parse empty" $ testByteHelper "" Nothing + it "Can parse 0" $ testDecOctetHelper "0" (Just 0) + it "Can parse 10" $ testDecOctetHelper "10" (Just 10) + it "Can parse 100" $ testDecOctetHelper "100" (Just 100) + it "Can parse 249" $ testDecOctetHelper "249" (Just 249) + it "Can parse 255" $ testDecOctetHelper "255" (Just 255) + it "Can parse 260 as 26" $ testDecOctetHelper "256" (Just 25) + it "Can parse 256 as 25" $ testDecOctetHelper "256" (Just 25) + it "Can parse 2550 as 255" $ testDecOctetHelper "2550s" (Just 255) + it "Can't parse -1" $ testDecOctetHelper "-1" Nothing + it "Can't parse empty" $ testDecOctetHelper "" Nothing testIPv4 :: IO () testIPv4 = hspec $ do @@ -87,188 +228,99 @@ testIPv4 = hspec $ do it "Can't parse 0..0.0.0" $ do testIPv4Helper "0..0.0.0" Nothing -toIPAddress6 :: IPAddress -> IPAddress6 -toIPAddress6 (IPAddress w32) = IPAddress6 0 (fromIntegral w32) - --- Exercise 7 - --- Datatypes: -data IPAddress6 = IPAddress6 Word64 Word64 deriving (Eq, Ord) --- An IPv6Piece is the part between ':', it can be either --- "::" or "ABCD" -type IPv6Piece = Either () Word16 - --- -toArray :: IPAddress6 -> [Word16] -toArray (IPAddress6 w64 w64') = - let n = toInteger w64 - m = toInteger w64' - mask = fromInteger . (\a -> (.&.) a 0xFFFF) - in mask (n `shiftR` 48) : - mask (n `shiftR` 32) : - mask (n `shiftR` 16) : - mask n : - mask (m `shiftR` 48) : - mask (m `shiftR` 32) : - mask (m `shiftR` 16) : - mask m : [] - -toArray' :: [Word16] -> [Either Int Word16] -toArray' [] = [] -toArray' s@(0:0:_) = (Left $ length ys) : (toArray' zs) - where (ys, zs) = span (==0) s -toArray' (x:xs) = (Right x) : toArray' xs - -findMax :: [Either Int Word16] -> Maybe Int -findMax xs = go $ lefts xs - where go [] = Nothing - go ys = Just $ maximum ys - -replaceLeft :: Int -> [Either Int Word16] -> [IPv6Piece] -replaceLeft m xs = go m xs False - where go _ [] _ = [] - go i ((Right c):ys) b = (Right c) : (go i ys b) - go i ((Left c):ys) False = - if (c == i) - then (Left ()) : (go i ys True) - else (replicate c (Right 0)) ++ (go i ys False) - go i ((Left c):ys) True = (replicate c (Right 0)) ++ (go i ys True) - -showPieces :: [IPv6Piece] -> String -showPieces [] = "" -showPieces ((Right c):ys) = (showHex c "") ++ (go ys) - where go [] = [] - go (Right c':zs) = ":" ++ (showHex c' "") ++ (go zs) - go zs = showPieces zs -showPieces ((Left ():ys)) = "::" ++ (showPieces ys) - +-- IPv6 +testParseFirstHelper :: IPv6ParseOption + -> String + -> Maybe [Integer] + -> Expectation +testParseFirstHelper o s r = do + let m = parseString (parseFirst o) mempty s + r' = maybeSuccess m + r' `shouldBe` r -instance Show IPAddress6 where - show p = let xs = toArray' (toArray p) - in showPieces $ (case findMax xs of - Nothing -> replaceLeft 0 xs - (Just i) -> replaceLeft i xs) - -validHex :: String -validHex = "abcdefABCDEF0123456789" - --- Helper functions --- only parses [0-9A-Fa-f]{1,4} -readWord16 :: String -> Maybe Word16 -readWord16 s = - let r = readHex (take 4 s) :: [(Word16, String)] - in case r of - ((w,s'):[]) -> if s' == "" then Just w else Nothing - _ -> Nothing - -mkWord64 :: Word16 -> Word16 -> Word16 -> Word16 -> Word64 -mkWord64 a b c d = (fromIntegral a `shiftL` 48) + - (fromIntegral b `shiftL` 32) + - (fromIntegral c `shiftL` 16) + - (fromIntegral d) - -mkIPAddress6 :: [Word16] -> Maybe IPAddress6 -mkIPAddress6 xs = - case length xs of - 8 -> let (a,b) = splitAt 4 xs - w1 = (mkWord64 (a !! 0) (a !! 1) (a !! 2) (a !! 3)) - w2 = (mkWord64 (b !! 0) (b !! 1) (b !! 2) (b !! 3)) - in Just $ IPAddress6 w1 w2 - _ -> Nothing - -expandIPv6Pieces :: [IPv6Piece] -> Maybe [Word16] -expandIPv6Pieces xs = - case length $ filter (==(Left ())) xs of - 0 -> Just $ foldr f [] xs - 1 -> Just $ foldr g [] xs - _ -> Nothing - where f (Left _) s = s - f (Right c) s = c:s - n = max (9 - (length xs)) 0 - g (Left _) s = (take n $ repeat 0) ++ s - g (Right c) s = c:s - -getIPAddress6 :: [IPv6Piece] -> Maybe IPAddress6 -getIPAddress6 xs = expandIPv6Pieces xs >>= mkIPAddress6 - -type IPv6State = Bool -type IPv6Parser a = StateT IPv6State Parser a - --- Parsing the individual pieces: --- hex, 1-4 hexes, ':', '::' -parseSingleHex :: IPv6Parser Char -parseSingleHex = do - c <- oneOf validHex - return c - -parseIPv6Hex :: IPv6Parser Word16 -parseIPv6Hex = do - c1 <- parseSingleHex "At least one hex" - o <- mapStateT f $ count 3 $ optional parseSingleHex - let s = c1 : (fromMaybe "" o) - case readWord16 s of - Just w -> return w - Nothing -> unexpected $ "Invalid piece: " ++ s - where f :: Parser ([Maybe Char], IPv6State) - -> Parser (Maybe [Char], IPv6State) - f = fmap (\(c,b) -> (sequence c, b)) - -parseSep :: IPv6Parser String -parseSep = do - c <- string ":" - return c - -parseCons :: IPv6Parser (Maybe IPv6Piece) -parseCons = do - b <- get - c <- optional $ string "::" - case c of - Nothing -> return Nothing - Just _ -> if b - then unexpected "Only one '::' allowed" - else do - put True - return (Just $ Left ()) - --- Parses: --- ::ABCD --- :ABCD -parseInnerParts :: IPv6Parser [IPv6Piece] -parseInnerParts = do - c <- parseCons - case c of - Nothing -> do - parseSep - w <- parseIPv6Hex - return [Right w] - Just _ -> do - w <- parseIPv6Hex - return [Left (), Right w] - - -parseIPv6Address :: IPv6Parser IPAddress6 -parseIPv6Address = do - c <- parseCons - w <- parseIPv6Hex - a <- case c of - Nothing -> do - xs <- mapStateT f $ many parseInnerParts - c' <- parseCons - case c' of - Nothing -> return ([Right w] ++ xs) - Just _ -> return ([Right w] ++ xs ++ [Left ()]) - Just _ -> do - xs <- mapStateT f $ many parseInnerParts - return $ ([Left ()] ++ [Right w] ++ xs) - case getIPAddress6 a of - Nothing -> unexpected "Invalid format" - Just a' -> return a' - where f :: Parser ([[IPv6Piece]], IPv6State) - -> Parser ([IPv6Piece], IPv6State) - f = fmap (\(xs, b) -> (concat xs, b)) +testParseFirst :: IO () +testParseFirst = hspec $ do + describe "Test parsing of parseFirst NoCons" $ do + it "Can parse anything" $ do + testParseFirstHelper NoCons "" (Just []) + describe "Test parsing of parseFirst Cons0" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons0 "::" (Just [0]) + it "Cannot parse non '::'" $ do + testParseFirstHelper Cons0 "a::" (Nothing) + describe "Test parsing of parseFirst Cons1" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons1 "::" (Just [0, 0]) + it "Can parse 'f::'" $ do + testParseFirstHelper Cons1 "f::" (Just [15,0]) + it "Cannot parse f:f::" $ do + testParseFirstHelper Cons1 "f:f::" Nothing + describe "Test parsing of parseFirst Cons2" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons2 "::" (Just [0, 0, 0]) + it "Can parse 'f::'" $ do + testParseFirstHelper Cons2 "f::" (Just [15,0,0]) + it "Can parse 'f:f::'" $ do + testParseFirstHelper Cons2 "f:f::" (Just [15,15,0]) + it "Cannot parse f:f:f::" $ do + testParseFirstHelper Cons2 "f:f:f::" Nothing + describe "Test parsing of parseFirst Cons3" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons3 "::" (Just [0, 0, 0, 0]) + it "Can parse 'f::'" $ do + testParseFirstHelper Cons3 "f::" (Just [15,0,0,0]) + it "Can parse 'f:f::'" $ do + testParseFirstHelper Cons3 "f:f::" (Just [15,15,0,0]) + it "Can parse 'f:f:f::'" $ do + testParseFirstHelper Cons3 "f:f:f::" (Just [15,15,15,0]) + it "Cannot parse f:f:f:f::" $ do + testParseFirstHelper Cons3 "f:f:f:f::" Nothing + describe "Test parsing of parseFirst Cons4" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons4 "::" (Just [0, 0, 0, 0, 0]) + it "Can parse 'f::'" $ do + testParseFirstHelper Cons4 "f::" (Just [15,0,0,0, 0]) + it "Can parse 'f:f::'" $ do + testParseFirstHelper Cons4 "f:f::" (Just [15,15,0,0,0]) + it "Can parse 'f:f:f::'" $ do + testParseFirstHelper Cons4 "f:f:f::" (Just [15,15,15,0, 0]) + it "Can parse f:f:f:f::" $ do + testParseFirstHelper Cons4 "f:f:f:f::" (Just [15,15,15,15, 0]) + it "Cannot parse f:f:f:f:f::" $ do + testParseFirstHelper Cons4 "f:f:f:f:f::" Nothing + describe "Test parsing of parseFirst Cons5" $ do + it "Can parse only '::'" $ do + testParseFirstHelper Cons5 "::" (Just [0, 0, 0, 0, 0, 0]) + it "Can parse 'f::'" $ do + testParseFirstHelper Cons5 "f::" (Just [15,0,0,0, 0, 0]) + it "Can parse 'f:f::'" $ do + testParseFirstHelper Cons5 "f:f::" (Just [15,15,0,0,0, 0]) + it "Can parse 'f:f:f::'" $ do + testParseFirstHelper Cons5 "f:f:f::" (Just [15,15,15,0, 0, 0]) + it "Can parse f:f:f:f::" $ do + testParseFirstHelper Cons5 "f:f:f:f::" (Just [15,15,15,15, 0, 0]) + it "Can parse f:f:f:f:f::" $ do + testParseFirstHelper Cons5 "f:f:f:f:f::" (Just [15,15,15,15,15, 0]) + it "Cannot parse f:f:f:f:f:f::" $ do + testParseFirstHelper Cons5 "f:f:f:f:f:f::" Nothing + -- rest is copy-paste but also not necessary since they're all + -- handled the same way in the parseFirst method. + + +testIPv6Helper :: String -> Maybe IPAddress6 -> Expectation +testIPv6Helper s r = do + let m = parseString parseIPv6Address mempty s + r' = maybeSuccess m + r' `shouldBe` r -toIPAddress :: IPAddress6 -> Maybe IPAddress -toIPAddress (IPAddress6 w64 w64') - | w64 /= 0 = Nothing - | w64' > (fromIntegral $ (maxBound :: Word32)) = Nothing - | otherwise = Just $ IPAddress (fromIntegral w64') \ No newline at end of file +testIPv6 :: IO () +testIPv6 = hspec $ do + describe "Test parsing of IPv6" $ do + it "Can parse 0:0:1:0:0:0:1:0" $ do + testIPv6Helper "0:0:1:0:0:0:1:0" (Just (IPAddress6 65536 65536)) + it "Can parse ::0:1:0:0:0:1:0" $ do + testIPv6Helper "::0:1:0:0:0:1:0" (Just (IPAddress6 65536 65536)) + it "Can parse ::1:0:0:0:1:0" $ do + testIPv6Helper "::1:0:0:0:1:0" (Just (IPAddress6 65536 65536)) + it "Can parse 0::1:0:0:0:1:0" $ do + testIPv6Helper "0::1:0:0:0:1:0" (Just (IPAddress6 65536 65536)) \ No newline at end of file diff --git a/24-parser-combination/src/ParseLog.hs b/24-parser-combination/src/ParseLog.hs index 704125e..ccd06d0 100644 --- a/24-parser-combination/src/ParseLog.hs +++ b/24-parser-combination/src/ParseLog.hs @@ -3,15 +3,18 @@ module ParseLog where -import Control.Applicative ((<|>), liftA2) +import Control.Applicative ((<|>), liftA2, liftA3) import Data.Monoid ((<>)) import Text.Trifecta import Data.Time.Format import Data.Time import Data.List (intersperse) import Text.RawString.QQ - +import Text.Parser.Token +import Control.Monad (replicateM) +import Data.Maybe import Test.QuickCheck +import Data.Char data LogEntry = LogEntry TimeOfDay String deriving Eq instance Show LogEntry where @@ -20,10 +23,13 @@ instance Show LogEntry where in time ++ " " ++ s instance Arbitrary LogEntry where arbitrary = do - tod <- TimeOfDay <$> choose (0,23) <*> choose (0,59) <*> pure 0 - s <- liftA2 (++) + tod <- liftA3 TimeOfDay + (choose (0,23)) + (choose (0,59)) + (pure 0) + s <- liftA2 (++) arbitrary - (oneof [((++) "--") <$> arbitrary, arbitrary]) + (oneof [((++) "--") <$> arbitrary, arbitrary]) return $ LogEntry tod (filter (\c -> c /= '\n') s) data DayEntry = DayEntry Day [LogEntry] deriving Eq @@ -49,11 +55,11 @@ instance Arbitrary Log where countTimeSpentDay :: [LogEntry] -> DiffTime countTimeSpentDay [] = 0 countTimeSpentDay (_:[]) = 0 -countTimeSpentDay (x:y:xs) = +countTimeSpentDay (x:y:xs) = let (LogEntry t1 _) = x (LogEntry t2 _) = y - in (timeOfDayToTime t2) - - (timeOfDayToTime t1) + in (timeOfDayToTime t2) + - (timeOfDayToTime t1) + (countTimeSpentDay (y:xs)) countDay :: DayEntry -> DiffTime @@ -62,64 +68,78 @@ countDay (DayEntry _ e) = countTimeSpentDay e countTime :: Log -> DiffTime countTime (Log ds) = sum $ map countDay ds -skipBlankLines :: Parser () -skipBlankLines = - skipMany $ (skipWhiteSpace >> skipComment >> newline) <|> - (skipWhiteSpace >> newline) +skipComment :: (Monad m, TokenParsing m) => m () +skipComment = token $ do + string "--" + manyTill anyChar $ try newline + return () -skipComment :: Parser () -skipComment = skipMany $ do - _ <- count 2 $ char '-' - skipMany $ notChar '\n' +myToken :: (Monad m, TokenParsing m) => m a -> m a +myToken p = token p <* (token $ skipSome skipComment <|> pure ()) -skipWhiteSpace :: Parser () -skipWhiteSpace = skipMany $ oneOf "\t " +-- token :: m a -> m a +-- token p = p <* (someSpace <|> pure ()) -removeComment :: String -> String -removeComment [] = [] -removeComment (x:xs) = go "" x False xs - where go s '-' True _ = s -- skip comment - go s '-' False [] = s ++ "-" -- ended with '-' - go s c _ [] = s ++ [c] -- ended without comment - go s '-' False (y:ys) = go s y True ys -- possible start of comment - go s c _ (y:ys) = go (s ++ [c]) y False ys +parseHour :: Parser String +parseHour = case1 <|> case2 + where case1 = sequenceA [oneOf "01", digit] + case2 = sequenceA [char '2', oneOf "0123"] +parseMinutes :: Parser String +parseMinutes = sequenceA [ oneOf "012345", digit] -parseLogEntry :: Parser LogEntry -parseLogEntry = do - t <- count 2 digit <> string ":" <> count 2 digit - let m = parseTimeM True defaultTimeLocale "%H:%M" t - timeOfDay <- case m of +parseTimeOfDay :: Parser TimeOfDay +parseTimeOfDay = do + timeString <- parseHour <> string ":" <> parseMinutes + case parseTimeM True defaultTimeLocale "%H:%M" timeString of Just time -> return time Nothing -> unexpected "Incorrect time format" - _ <- space - s <- some $ notChar '\n' - _ <- newline - return $ LogEntry timeOfDay (removeComment s) -parseDayEntry :: Parser DayEntry -parseDayEntry = do - _ <- char '#' - _ <- space - d <- some digit <> string "-" - <> count 2 digit <> string "-" - <> count 2 digit - let m = parseTimeM True defaultTimeLocale "%Y-%m-%d" d - day <- case m of +parseLogEntry :: Parser LogEntry +parseLogEntry = myToken $ do + tod <- parseTimeOfDay + space + s <- manyTill anyChar ((newline >> return ()) <|> skipComment) + return $ LogEntry tod s + +parseYear :: Parser String +parseYear = count 4 digit + +-- This is actually also a cool way to do this, where the year +-- can consist up to 4 digits instead of 4, but this is not in the spirit of +-- the exercise I believe. year should be in "YYYY" format. +-- parseYear = liftA2 (:) digit (catMaybes <$> replicateM 3 d) +-- where d = try $ optional digit + +parseMonth :: Parser String +parseMonth = case1 <|> case2 + where case1 = sequenceA [ char '0', digit ] + case2 = sequenceA [ char '1', oneOf "012"] + +parseDay :: Parser String +parseDay = case1 <|> case2 + where case1 = sequenceA [ oneOf "012", digit ] + case2 = sequenceA [ char '3', oneOf "01" ] + +parseDay' :: Parser Day +parseDay' = do + day <- parseYear <> string "-" <> parseMonth <> string "-" <> parseDay + case parseTimeM True defaultTimeLocale "%Y-%m-%d" day of Just day' -> return day' Nothing -> unexpected "Incorrect day format" - -- only thing allowed after day is whitespace and comments - skipWhiteSpace - skipComment - _ <- newline - -- Followed by a list of paserLogEntries + +parseDayEntry :: Parser DayEntry +parseDayEntry = myToken $ do + char '#' + space + day <- myToken $ parseDay' logEntries <- many parseLogEntry - skipBlankLines - return $ DayEntry day logEntries + return $ DayEntry day logEntries parseLog :: Parser Log parseLog = do - skipBlankLines + whiteSpace + skipMany skipComment dayEntries <- many parseDayEntry return $ Log dayEntries @@ -161,7 +181,7 @@ genDayLine = do day <- ModifiedJulianDay <$> (2000 +) <$> arbitrary let day_string = formatTime defaultTimeLocale "%Y-%m-%d" day oneof [ return $ "# " ++ day_string ++ "\t \n" - , return $ "# " ++ day_string ++ "\t -- comment!\n" ] + , return $ "# " ++ day_string ++ "\t -- comment!\n" ] genLogEntry :: Gen String genLogEntry = do time <- TimeOfDay <$> choose (0,23) <*> choose (0,59) <*> pure 0 diff --git a/24-parser-combination/src/PhoneNumber.hs b/24-parser-combination/src/PhoneNumber.hs index 537037c..0d34d80 100644 --- a/24-parser-combination/src/PhoneNumber.hs +++ b/24-parser-combination/src/PhoneNumber.hs @@ -3,37 +3,47 @@ module PhoneNumber where import Control.Applicative ((<|>)) +import Control.Monad (replicateM) + import Text.Trifecta import Test.Hspec +import qualified Test.QuickCheck as Q +import qualified Test.QuickCheck.Property as QP +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Gen + +import Data.Maybe (isJust) +import Data.Char (isDigit) + -- This is an exercise for the Belgian Phone numbers system -- From wikipedia {- -Belgian telephone numbers consist of two major parts: Firstly '0', secondly the -"zone prefix" (A) which is 1 or 2 digits long for landlines and 3 digits long +Belgian telephone numbers consist of 3 major parts: First '0', second the +"zone prefix" (A) which is 1 or 2 digits long for landlines and 3 digits long for mobile phones and thirdly the "subscriber's number" (B). -Land lines are always 9 digits long. They are prefixed by a zero, followed by -the zone prefix. Depending on the length of the zone prefix, the subscriber's -number consists of either 6 or 7 digits. Hence land line numbers are written +Land lines are always 9 digits long. They are prefixed by a zero, followed by +the zone prefix. Depending on the length of the zone prefix, the subscriber's +number consists of either 6 or 7 digits. Hence land line numbers are written either 0AA BB BB BB or 0A BBB BB BB. -Mobile Phone numbers always consist of 10 digits. The first digit of the "zone -prefix" of a mobile number is always '4'. Then follows 2 digits indicating to -which Mobile Operator's pool the number originally belonged when it was taken -into usage. The fourth digit represents a "sub-group" of this pool and has no -additional meaning other than increasing the amount of possible numbers. The -subscriber's number consists of 6 digits. Hence, mobile phone numbers are -written 04AA BB BB BB. Sometimes, the last 6 digits are written in two groups +Mobile Phone numbers always consist of 10 digits. The first digit of the "zone +prefix" of a mobile number is always '4'. Then follows 2 digits indicating to +which Mobile Operator's pool the number originally belonged when it was taken +into usage. The fourth digit represents a "sub-group" of this pool and has no +additional meaning other than increasing the amount of possible numbers. The +subscriber's number consists of 6 digits. Hence, mobile phone numbers are +written 04AA BB BB BB. Sometimes, the last 6 digits are written in two groups of 3 digits to increase readability: 04AA BBB BBB. -Numbers are sometimes written with a slash in between the zone prefix and the -subscriber's number. This is the case for both land lines and mobile phone -numbers. Sometimes, dots are written between the blocks of the subscriber's -number. Examples: 0AA/BB BB BB, 0AA/BB.BB.BB; for mobile numbers: +Numbers are sometimes written with a slash in between the zone prefix and the +subscriber's number. This is the case for both land lines and mobile phone +numbers. Sometimes, dots are written between the blocks of the subscriber's +number. Examples: 0AA/BB BB BB, 0AA/BB.BB.BB; for mobile numbers: 04AA/BB BB BB, 04AA/BB.BB.BB or 04AA/BBB.BBB. -The international country code prefix for Belgium is "+32". When dialing a +The international country code prefix for Belgium is "+32". When dialing a number with the prefix, the 0 can be dropped, e.g.: +32 4AA BB BB BB. -} @@ -42,19 +52,21 @@ number with the prefix, the 0 can be dropped, e.g.: +32 4AA BB BB BB. -- Will only look at landlines and phonelines -- not special numbers or non-geographic numbers -data ZonePrefix = MobileZP String - | LandOneZP String +data ZonePrefix = MobileZP String + | LandOneZP String | LandTwoZP String deriving (Eq) + instance Show ZonePrefix where show (MobileZP s) = "0" ++ s show (LandOneZP s) = " 0" ++ s show (LandTwoZP s) = " 0" ++ s -data SubscribersNumber = MobileSN String - | LandOneSN String +data SubscribersNumber = MobileSN String + | LandOneSN String | LandTwoSN String deriving (Eq) + instance Show SubscribersNumber where show (LandOneSN (a:b:c:d:e:f:g:[])) = a:b:c:" " ++ d:e:" " ++ f:g:[] show (LandOneSN s) = "Invalid format: " ++ s @@ -64,43 +76,32 @@ instance Show SubscribersNumber where show (LandTwoSN s) = "Invalid format: " ++ s data PhoneNumberBE = PhoneNumberBE ZonePrefix SubscribersNumber deriving Eq + instance Show PhoneNumberBE where - show (PhoneNumberBE z s) = "(PhoneNumberBE " ++ show z - ++ " " - ++ show s + show (PhoneNumberBE z s) = "(PhoneNumberBE " ++ show z + ++ " " + ++ show s ++ ")" - -- Mobile numbers are: 046x 047x 048x 049x -- Land lines are most other things where: -- 02,03,04 and 09 are single digit land line area codes -- the rest are two digit land line phone parseZonePrefix :: Parser ZonePrefix parseZonePrefix = - let mobile = MobileZP <$> do - one <- char '4' - two <- oneOf ['6', '7', '8', '9'] - three <- digit - return $ [one, two, three] + let mobile = do + one <- char '4' + two <- oneOf ['6', '7', '8', '9'] + three <- digit + return $ MobileZP [one, two, three] landOne = LandOneZP . (:[]) <$> oneOf ['2', '3', '4', '9'] landTwo = LandTwoZP <$> count 2 digit -- Order is important, we want to check mobile first, followed by -- landOne. Everything else is assumed to be land two - in mobile <|> landOne <|> landTwo - -parseMobileSN :: Parser SubscribersNumber -parseMobileSN = do - let p = count 2 digit - skip = skipOptional $ char ' ' <|> char '.' - p1 <- p - skip - p2 <- p - skip - p3 <- p - return . MobileSN $ p1 ++ p2 ++ p3 + in try mobile <|> landOne <|> landTwo -parseLandTwoSN :: Parser SubscribersNumber -parseLandTwoSN = do +parseSNOfSix :: Parser String +parseSNOfSix = do let p = count 2 digit skip = skipOptional $ char ' ' <|> char '.' p1 <- p @@ -108,10 +109,10 @@ parseLandTwoSN = do p2 <- p skip p3 <- p - return . LandTwoSN $ p1 ++ p2 ++ p3 + return $ p1 ++ p2 ++ p3 -parseLandOneSN :: Parser SubscribersNumber -parseLandOneSN = do +parseSNOfSeven :: Parser String +parseSNOfSeven = do let p = count 2 digit skip = skipOptional $ char ' ' <|> char '.' p1 <- count 3 digit @@ -119,7 +120,7 @@ parseLandOneSN = do p2 <- p skip p3 <- p - return . LandTwoSN $ p1 ++ p2 ++ p3 + return $ p1 ++ p2 ++ p3 parsePhone :: Parser PhoneNumberBE parsePhone = do @@ -128,45 +129,186 @@ parsePhone = do -- white space skipMany $ char ' ' -- Leading zero depends on country code - skipOptional $ char ' ' _ <- case m of Just _ -> do - a <- optional $ char '0' - case a of - Nothing -> return Nothing - Just _ -> unexpected "0 not expected here" + a <- optional $ char '0' + case a of + Nothing -> return Nothing + Just _ -> unexpected "0 not expected here" Nothing -> Just <$> char '0' z <- parseZonePrefix skipOptional $ char ' ' <|> char '/' s <- case z of - MobileZP _ -> parseMobileSN - LandOneZP _ -> parseLandOneSN - LandTwoZP _ -> parseLandTwoSN + MobileZP _ -> MobileSN <$> parseSNOfSix + LandOneZP _ -> LandOneSN <$> parseSNOfSix + LandTwoZP _ -> LandTwoSN <$> parseSNOfSeven return $ PhoneNumberBE z s - + +-- Tests + maybeSuccess :: Result a -> Maybe a maybeSuccess (Success a) = Just a maybeSuccess _ = Nothing --- Should test all options for mobile and single-digit land lines, --- but that is just copy-paste... QuickCheck could also help. +-- ZonePrefix +validMobileZonePrefix :: [String] +validMobileZonePrefix = + [(++) "4"] <*> (map ((++) . show) [6..9] <*> map show [0..9]) + +validLandOneZonePrefix :: [String] +validLandOneZonePrefix = ["2", "3", "4", "9"] + +validLandTwoZonePrefix :: [String] +validLandTwoZonePrefix = + map (++) ["1", "5", "6", "7", "8"] <*> map show [0..9] + +invalidZonePrefix :: [String] +invalidZonePrefix = ["0", "a"] + +validMobileZonePrefixTest :: (String -> ZonePrefix) -> String -> SpecWith () +validMobileZonePrefixTest zp input = do + it ("Zone prefix: " ++ input) $ do + let m = parseString parseZonePrefix mempty input + r = maybeSuccess m + r `shouldBe` Just (zp input) + +invalidZonePrefixTest :: String -> SpecWith () +invalidZonePrefixTest input = do + it ("Zone prefix: " ++ input) $ do + let m = parseString parseZonePrefix mempty input + r = maybeSuccess m + r `shouldBe` Nothing + +zonePrefixTests :: Spec +zonePrefixTests = do + describe "Parsing valid Mobile Zone Prefixes" $ do + mapM_ (validMobileZonePrefixTest MobileZP) validMobileZonePrefix + describe "Parsing valid Land One Zone Prefixes" $ do + mapM_ (validMobileZonePrefixTest LandOneZP) validLandOneZonePrefix + describe "Parsing valid Land Two Zone Prefixes" $ do + mapM_ (validMobileZonePrefixTest LandTwoZP) validLandTwoZonePrefix + describe "Parsing invalid Zone Prefixes" $ do + mapM_ invalidZonePrefixTest invalidZonePrefix + +gen_MobileZP :: Gen String +gen_MobileZP = do + c1 <- elements ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] + c2 <- elements ['6', '7', '8', '9'] + return $ ['4', c2, c1] + +gen_LandOneZP :: Gen String +gen_LandOneZP = elements ["2", "3", "4", "9"] + +gen_LandTwoZP :: Gen String +gen_LandTwoZP = do + c1 <- elements ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] + c2 <- elements ['1', '5', '6', '7', '8'] + return $ [c2, c1] + +prop_ZP :: Gen String -> (String -> ZonePrefix) -> QP.Property +prop_ZP g c = QP.forAll g $ \input -> + let r = maybeSuccess m + m = parseString parseZonePrefix mempty input + in isJust r + +-- Subscriber Number +gen_MobileSN :: Gen String +gen_MobileSN = do + let c = elements ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] + p1 <- replicateM 2 c + r <- replicateM 2 $ do + s1 <- elements [" ", "."] + p2 <- replicateM 2 c + return $ s1 ++ p2 + return $ p1 ++ (concat r) + +gen_LandOneSN :: String -> Gen String +gen_LandOneSN zp = do + let c = elements ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] + c1 <- case zp of + "4" -> elements ['0', '1', '2', '3', '4', '5'] + otherwise -> c + c2 <- c + r <- replicateM 2 $ do + s1 <- elements [" ", "."] + p2 <- replicateM 2 c + return $ s1 ++ p2 + return $ c1:c2:(concat r) + +gen_LandOneSN' :: Gen String +gen_LandOneSN' = do + zp <- gen_LandOneZP + gen_LandOneSN zp + +gen_LandTwoSN :: Gen String +gen_LandTwoSN = do + let c = elements ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] + p1 <- replicateM 3 c + r <- replicateM 2 $ do + s1 <- elements [" ", "."] + p2 <- replicateM 2 c + return $ s1 ++ p2 + return $ p1 ++ (concat r) + +prop_SN :: Gen String -> Parser String -> QP.Property +prop_SN g p = QP.forAll g $ \input -> + let r = maybeSuccess m + m = parseString p mempty input + in isJust r + +-- Phone Number +gen_Spaces :: Gen String +gen_Spaces = listOf $ return ' ' + +gen_CountryCode :: Gen String +gen_CountryCode = do + sp <- gen_Spaces + return $ "+32" ++ sp + +gen_NoCountryCode :: Gen String +gen_NoCountryCode = do + sp <- gen_Spaces + return $ sp ++ "0" + +gen_MobileNumber :: Gen String +gen_MobileNumber = do + cc <- oneof [gen_CountryCode, gen_NoCountryCode] + zp <- gen_MobileZP + sep <- elements ["/", " ", ""] + sn <- gen_MobileSN + return $ cc ++ zp ++ sep ++ sn + +gen_LandOneNumber :: Gen String +gen_LandOneNumber = do + cc <- oneof [gen_CountryCode, gen_NoCountryCode] + zp <- gen_LandOneZP + sep <- elements ["/", " ", ""] + sn <- gen_LandOneSN zp + return $ cc ++ zp ++ sep ++ sn + +gen_LandTwoNumber :: Gen String +gen_LandTwoNumber = do + cc <- oneof [gen_CountryCode, gen_NoCountryCode] + zp <- gen_LandTwoZP + sep <- elements ["/", " ", ""] + sn <- gen_LandTwoSN + return $ cc ++ zp ++ sep ++ sn + +prop_PhoneNumberBE :: QP.Property +prop_PhoneNumberBE = QP.forAll g $ \input -> + let r = maybeSuccess m + m = parseString parsePhone mempty input + in isJust r + where g = oneof [gen_MobileNumber, gen_LandOneNumber, gen_LandTwoNumber] + main :: IO () -main = hspec $ do - describe "Parse Zone Prefix" $ do - it "Mobile starts with 4[6-9]x " $ do - let m = parseString parseZonePrefix mempty "472" - r = maybeSuccess m - r `shouldBe` Just (MobileZP "472") - it "Incorrect mobile zone prefix should fail" $ do - let m = parseString parseZonePrefix mempty "47" - r = maybeSuccess m - r `shouldBe` Nothing - it "Land line with single digit" $ do - let m = parseString parseZonePrefix mempty "2" - r = maybeSuccess m - r `shouldBe` Just (LandOneZP "2") - it "Land line with double digit" $ do - let m = parseString parseZonePrefix mempty "55" - r = maybeSuccess m - r `shouldBe` Just (LandTwoZP "55") - -- ... \ No newline at end of file +main = do + hspec $ do + zonePrefixTests + Q.quickCheck $ prop_ZP gen_MobileZP MobileZP + Q.quickCheck $ prop_ZP gen_LandOneZP LandOneZP + Q.quickCheck $ prop_ZP gen_LandTwoZP LandTwoZP + Q.quickCheck $ prop_SN gen_MobileSN parseSNOfSix + Q.quickCheck $ prop_SN gen_LandOneSN' parseSNOfSix + Q.quickCheck $ prop_SN gen_LandTwoSN parseSNOfSeven + Q.quickCheckWith Q.stdArgs { Q.maxSuccess = 10000 } $ prop_PhoneNumberBE \ No newline at end of file diff --git a/24-parser-combination/src/PosInt.hs b/24-parser-combination/src/PosInt.hs index 86725f8..b2a973c 100644 --- a/24-parser-combination/src/PosInt.hs +++ b/24-parser-combination/src/PosInt.hs @@ -10,8 +10,8 @@ parseDigit = oneOf ['0'..'9'] base10Integer :: Parser Integer base10Integer = do - xs <- some $ (\a -> read (a:"")) <$> parseDigit - return $ + xs <- (fmap . fmap) (read . (:[])) $ some parseDigit + return $ fst $ foldr (\a (b,i) -> (a * i + b, i*10)) (0,1) xs parseSign :: Parser Char @@ -74,7 +74,7 @@ main = hspec $ do let m = parseString parseDigit mempty "a" r = maybeSuccess m r `shouldBe` Nothing - + describe "Parse Integer" $ do it "can parse single digit" $ do let m = parseString base10Integer mempty "3" @@ -88,7 +88,7 @@ main = hspec $ do let m = parseString base10Integer mempty "x23" r = maybeSuccess m r `shouldBe` Nothing - + describe "Parse Sign" $ do it "Minus" $ do let m = parseString parseSign mempty "-" @@ -102,7 +102,7 @@ main = hspec $ do let m = parseString parseSign mempty "1" r = maybeSuccess m r `shouldBe` Nothing - + describe "Parse Positive Integer" $ do it "positive without +" $ do let m = parseString base10Integer' mempty "123abc" @@ -112,10 +112,9 @@ main = hspec $ do let m = parseString base10Integer' mempty "+123abc" r = maybeSuccess m r `shouldBe` Just 123 - + describe "Parse negative integer" $ do it "negative" $ do let m = parseString base10Integer' mempty "-123abc" r = maybeSuccess m r `shouldBe` Just (-123) - \ No newline at end of file diff --git a/24-parser-combination/src/SemVer.hs b/24-parser-combination/src/SemVer.hs index bde0d31..9b0218a 100644 --- a/24-parser-combination/src/SemVer.hs +++ b/24-parser-combination/src/SemVer.hs @@ -19,21 +19,8 @@ data SemVer = SemVer Major Minor Patch Release Metadata deriving (Eq, Show) -- Probably nicer ways of doing this? instance Ord SemVer where compare (SemVer major minor patch _ _) - (SemVer major' minor' patch' _ _) = - -- case compare major major' of - -- GT -> GT - -- LT -> LT - -- EQ -> - -- case compare minor minor' of - -- GT -> GT - -- LT -> LT - -- EQ -> - -- case compare patch patch' of - -- GT -> GT - -- LT -> LT - -- EQ -> EQ - mconcat $ - zipWith compare [major, minor, patch] [major', minor', patch'] + (SemVer major' minor' patch' _ _) = mconcat $ + zipWith compare [major, minor, patch] [major', minor', patch'] validChars :: [Char] validChars = ['0'..'9'] ++ ['a'..'z'] ++ ['A'..'Z'] @@ -118,7 +105,7 @@ main = hspec $ do r = maybeSuccess m print m r `shouldBe` Nothing - + describe "Release parsing" $ do it "can parse release" $ do let m = parseString parseRelease mempty "-123.abc.123abc" @@ -142,7 +129,7 @@ main = hspec $ do r = maybeSuccess m print m r `shouldBe` Nothing - + describe "SemVer parsing" $ do it "can parse just version" $ do let m = parseString parseSemVer mempty "1.2.3" @@ -194,7 +181,7 @@ main = hspec $ do r = maybeSuccess m print m r `shouldBe` Just (SemVer 1 2 3 [NOSS "abc"] [NOSI 123]) - + describe "Comparing SemVer" $ do it "Bigger Major" $ do let a = SemVer 2 1 0 [] []