Complete chapter 24

24-parser-combination/24.11-chapter-exercises.md

@@ -0,0 +1,11 @@
+# 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).

24-parser-combination/24.3-parsing-practise.md

@@ -0,0 +1,2 @@
+# Exercises: Parsing Practise
+see src/LearnParsers.hs

24-parser-combination/24.4-unit-of-success.md

@@ -0,0 +1,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-parser-combination/24.6-try-try.md

@@ -0,0 +1,2 @@
+# Exercise: Try Try
+see src/TryTry.hs

24-parser-combination/src/AltParsing.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE QuasiQuotes #-}
+module AltParsing where
+
+import Control.Applicative
+import Text.RawString.QQ
+import Text.Trifecta
+
+type NumberOrString = Either Integer String
+
+a :: String
+a = "blah"
+b :: String
+b = "123"
+c :: String
+c = "123blah789"
+
+eitherOr :: String
+eitherOr = [r|
+123
+abc
+456
+def
+|]
+
+parseNos :: Parser NumberOrString
+parseNos = do
+    skipMany (oneOf "\n")
+    v <- (Left <$> integer) <|> (Right <$> some letter)
+    skipMany (oneOf "\n")
+    return v
+
+main :: IO ()
+main = do
+    let p f i = parseString f mempty i
+    print $ p (some letter) a
+    print $ p integer b
+    print $ p parseNos a
+    print $ p parseNos b
+    print $ p (many parseNos) c
+    print $ p (some parseNos) c
+    print $ p (some parseNos) eitherOr

24-parser-combination/src/BT.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+module BT where
+
+import Control.Applicative
+import qualified Data.Attoparsec.ByteString as A
+import Data.Attoparsec.ByteString (parseOnly)
+import Data.ByteString (ByteString)
+import Text.Trifecta hiding (parseTest)
+import Text.Parsec (Parsec, parseTest)
+
+-- Helper function to run a trifecta parser and print the result
+trifP :: Show a => Parser a -> String -> IO ()
+trifP p i = print $ parseString p mempty i
+
+-- Helper function to run a parsec parser and print the result
+parsecP :: Show a => Parsec String () a -> String -> IO ()
+parsecP = parseTest
+
+-- Helper function to runan attoparsec and print the result
+attoP :: Show a => A.Parser a -> ByteString -> IO ()
+attoP p i = print $ parseOnly p i
+
+-- Parsers
+nobackParse :: (Monad f, CharParsing f) => f Char
+nobackParse = (char '1' >> char '2') <|> char '3'
+
+tryParse :: (Monad f, CharParsing f) => f Char
+tryParse = try (char '1' >> char '2') <|> char '3'
+
+tryAnnot :: (Monad f, CharParsing f) => f Char
+tryAnnot = (try (char '1' >> char '2') <?> "Tried 12") 
+           <|> (char '3' <?> "Tried 3")
+
+-- Main
+main :: IO ()
+main = do
+    -- trifecta
+    trifP nobackParse "13"
+    trifP tryParse "13"
+    trifP tryAnnot "13"
+    -- parsec
+    parsecP nobackParse "13"
+    parsecP tryParse "13"
+    parsecP tryAnnot "13"
+    -- attoparsec
+    attoP nobackParse "13"
+    attoP tryParse "13"
+    attoP tryAnnot "13"

24-parser-combination/src/Fractions.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Text.Fractions where
+
+import Data.Attoparsec.Text (parseOnly)
+import Data.Ratio ((%))
+import Data.String (IsString)
+import Text.Trifecta
+
+badFraction :: IsString a => a
+badFraction = "1/0"
+alsoBad :: IsString a => a
+alsoBad = "10"
+shouldWork :: IsString a => a
+shouldWork = "1/2"
+shouldAlsoWork :: IsString a => a
+shouldAlsoWork = "2/1"
+
+-- parseFraction :: Parser Rational
+-- parseFraction = do
+--     numerator <- decimal
+--     char '/'
+--     denominator <- decimal
+--     return (numerator % denominator)
+
+-- virtuousFraction :: Parser Rational
+-- virtuousFraction = do
+--     numerator <- decimal
+--     char '/'
+--     denominator <- decimal
+--     case denominator of
+--         0 -> fail "Denominator cannot be zero"
+--         _ -> return (numerator % denominator)
+
+parseFraction :: (Monad m, TokenParsing m) => m Rational
+parseFraction = do
+    numerator <- decimal
+    char '/'
+    denominator <- decimal
+    case denominator of
+        0 -> fail "Denominator cannot be zero"
+        _ -> return (numerator % denominator)
+
+main :: IO ()
+main = do
+    -- parseOnly is Attoparsec
+    let attoP = parseOnly parseFraction
+    print $ attoP badFraction
+    print $ attoP shouldWork
+    print $ attoP shouldAlsoWork
+    print $ attoP alsoBad
+
+    -- parseString is Trifecta
+    let p = parseString parseFraction mempty
+    print $ p badFraction
+    print $ p shouldWork
+    print $ p shouldAlsoWork
+    print $ p alsoBad
+    -- let p = parseString parseFraction mempty
+    -- print $ p shouldWork
+    -- print $ p shouldAlsoWork
+    -- print $ p alsoBad
+    -- print $ p badFraction
+
+-- testVirtuous :: IO ()
+-- testVirtuous = do
+--     let virtuousFraction' = parseString virtuousFraction mempty
+--     print $ virtuousFraction' shouldWork
+--     print $ virtuousFraction' shouldAlsoWork
+--     print $ virtuousFraction' alsoBad
+--     print $ virtuousFraction' badFraction

24-parser-combination/src/GraphViz.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module GraphViz where
+

24-parser-combination/src/IPAddress.hs

@@ -0,0 +1,274 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module IPAddress where
+
+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 Test.Hspec
+
+-- Exercise 6
+data IPAddress = IPAddress Word32 deriving (Eq, Ord)
+instance Show IPAddress where
+    show (IPAddress w32) =
+        let n = toInteger w32
+        in show ((n `shiftR` 24) .&. 0xFF) ++ "." ++
+           show ((n `shiftR` 16) .&. 0xFF) ++ "." ++
+           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
+
+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
+        r' = maybeSuccess m
+    r' `shouldBe` r
+
+testIPv4Helper :: String -> Maybe IPAddress -> Expectation
+testIPv4Helper s r = do
+    let m = parseString parseIPv4Address mempty s
+        r' = maybeSuccess m
+    r' `shouldBe` r
+
+testByte :: IO ()
+testByte = 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    
+
+testIPv4 :: IO ()
+testIPv4 = hspec $ do
+    describe "Test parsing of IPv4" $ do
+        it "Can parse 0.0.0.0" $ do
+            testIPv4Helper "0.0.0.0" (Just (IPAddress 0))
+        it "Can parse 255.255.255.255" $ do
+            testIPv4Helper "255.255.255.255" (Just (IPAddress (2^32 - 1)))
+        it "Can parse 0.0.0.255.1" $ do
+            testIPv4Helper "0.0.0.255.1" (Just (IPAddress 255))
+        it "Can't parse .0.0.0.0" $ do
+            testIPv4Helper ".0.0.0.0" Nothing
+        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)
+            
+
+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))
+
+toIPAddress :: IPAddress6 -> Maybe IPAddress
+toIPAddress (IPAddress6 w64 w64')
+    | w64 /= 0 = Nothing
+    | w64' > (fromIntegral $ (maxBound :: Word32)) = Nothing
+    | otherwise = Just $ IPAddress (fromIntegral w64')

24-parser-combination/src/Ini.hs

@@ -0,0 +1,152 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Data.Ini where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Data.Char (isAlpha)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Test.Hspec
+import Text.RawString.QQ
+import Text.Trifecta
+
+headerEx :: ByteString
+headerEx = "[blah]"
+
+newtype Header = Header String deriving (Eq, Ord, Show)
+
+parseBracketPair :: Parser a -> Parser a
+parseBracketPair p = char '[' *> p <* char ']'
+
+parseHeader :: Parser Header
+parseHeader = parseBracketPair (Header <$> some letter)
+
+assignmentEx :: ByteString
+assignmentEx = "woot=1"
+
+type Name = String
+type Value = String
+type Assignments = Map Name Value
+
+parseAssignment :: Parser (Name, Value)
+parseAssignment = do
+    name <- some letter
+    _ <- char '='
+    val <- some (noneOf "\n")
+    skipEOL -- important!
+    return (name, val)
+
+    -- | Skip end of lien and whitespace beyond.
+skipEOL :: Parser ()
+skipEOL = skipMany (oneOf "\n")
+
+commentEx :: ByteString
+commentEx = "; last modified 11 November 2017 by John Doe"
+
+commentEx' :: ByteString
+commentEx' = "; blah\n; woot\n  \n; hah"
+
+-- | Skip comments starting at the beginning of the line
+skipComments :: Parser ()
+skipComments = skipMany $ do
+    _ <- char ';' <|> char '#'
+    skipMany (noneOf "\n")
+    skipEOL
+
+sectionEx :: ByteString
+sectionEx = "; ignore me\n[languages]\nGael=Haskell"
+
+sectionEx' :: ByteString
+sectionEx' = [r|
+; ignore me
+[languages]
+Gael=Haskell
+|]
+
+sectionEx'' :: ByteString
+sectionEx'' = [r|
+; comment
+[section]
+host=wikipedia.org
+alias=claw
+
+[whatisit]
+red=intoothandclaw
+|]
+
+data Section = Section Header Assignments deriving (Eq, Show)
+
+newtype Config = Config (Map Header Assignments) deriving (Eq, Show)
+
+skipWhitespace :: Parser ()
+skipWhitespace = skipMany (char ' ' <|> char '\n')
+
+parseSection :: Parser Section
+parseSection = do
+    skipWhitespace
+    skipComments
+    h <- parseHeader
+    skipEOL
+    assignments <- some parseAssignment
+    return $ Section h (M.fromList assignments)
+
+rollup :: Section -> Map Header Assignments -> Map Header Assignments
+rollup (Section h a) m = M.insert h a m
+
+parseIni :: Parser Config
+parseIni = do
+    sections <- some parseSection
+    let mapOfSections = foldr rollup M.empty sections
+    return $ Config mapOfSections
+
+maybeSuccess :: Result a -> Maybe a
+maybeSuccess (Success a) = Just a
+maybeSuccess _ = Nothing
+
+main :: IO ()
+main = hspec $ do
+    describe "Assignment Parsing" $
+        it "can parse a simple assignment" $ do
+            let m = parseByteString parseAssignment mempty assignmentEx
+                r' = maybeSuccess m
+            print m
+            r' `shouldBe` Just ("woot", "1")
+    describe "Header Parsing" $
+        it "can parse a simple header" $ do
+            let m = parseByteString parseHeader mempty headerEx
+                r' = maybeSuccess m
+            print m
+            r' `shouldBe` Just (Header "blah")
+    describe "Comment parsing" $
+        it "Skips comment before header" $ do
+            let p = skipComments >> parseHeader
+                i = "; woot\n[blah]"
+                m = parseByteString p mempty i
+                r' = maybeSuccess m
+            print m
+            r' `shouldBe` Just (Header "blah")
+    describe "Section parsing" $
+        it "can parse a simple section" $ do
+            let m = parseByteString parseSection mempty sectionEx
+                r' = maybeSuccess m
+                languages = M.fromList [("Gael", "Haskell")]
+                expected' = Just (Section (Header "languages") languages)
+            print m
+            r' `shouldBe` expected'
+    describe "INI parsing" $
+        it "Can parse multiple sections" $ do
+            let m = parseByteString parseIni mempty sectionEx''
+                r' = maybeSuccess m
+                sectionValues = M.fromList 
+                    [ ("alias", "claw") , ("host", "wikipedia.org")]
+                whatisitValues = M.fromList [("red", "intoothandclaw")]
+                expected' = Just (Config (M.fromList [ (Header "section"
+                                                     , sectionValues)
+                                                     , (Header "whatisit"
+                                                     , whatisitValues)]))
+            print m
+            r' `shouldBe` expected'            

24-parser-combination/src/LearnParsers.hs

@@ -0,0 +1,81 @@
+module LearnParsers where
+
+import Text.Trifecta
+import Text.Parser.Combinators (eof)
+
+import Control.Applicative ((<|>))
+
+stop :: Parser a
+stop = unexpected "stop"
+
+one :: Parser Char
+one = char '1'
+
+one' :: Parser Char
+one' = one >> stop
+
+oneTwo :: Parser Char
+oneTwo = char '1' >> char '2'
+
+oneTwo' :: Parser Char
+oneTwo' = oneTwo >> stop
+
+testParse :: Show a => Parser a -> IO ()
+testParse p = print $ parseString p mempty "123"
+
+-- testEOFParse :: Parser () -> IO ()
+-- testEOFParse p = print $ parseString p mempty "123"
+
+pNL :: String -> IO ()
+pNL s = putStrLn ('\n' : s)
+
+-- 1
+one'' :: Parser ()
+one'' = one >> eof
+
+oneTwo'' :: Parser ()
+oneTwo'' = oneTwo >> eof
+
+-- 2
+-- Looking at the documentation you can combine strings with <|>
+oneTwoThree :: Parser String
+-- Put the biggest string first as it matches from from left to right
+oneTwoThree = string "123" <|> string "12" <|> string "1"
+
+-- Other solution is to use choice to create a parser from other parser
+-- choice :: [Parser a] -> Parser a
+oneTwoThree' :: Parser String
+oneTwoThree' = choice [string "1", string "12", string "123"]
+
+-- 3
+-- Using foldr:
+string' :: String -> Parser String
+string' = foldr (\c p -> (:) c <$> p) (pure [])
+
+-- We haven't used the `char` function, if we do want to use it, we have
+-- to use <*>:
+string'' :: String -> Parser String
+string'' = foldr (\c p -> (:) <$> char c <*> p) (pure [])
+
+-- Which is basically:
+string''' :: String -> Parser String
+string''' = traverse char
+
+
+
+main :: IO ()
+main = do
+    pNL "stop:"
+    testParse (stop :: Parser Char)
+    pNL "one:"
+    testParse one
+    pNL "one':"
+    testParse one'
+    pNL "oneTwo:"
+    testParse oneTwo
+    pNL "oneTwo'"
+    testParse oneTwo'
+    pNL "one'':"
+    testParse one''
+    pNL "oneTwo'':"
+    testParse oneTwo''

24-parser-combination/src/Marshalling.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Marshalling where
+
+import Control.Applicative
+import Data.Aeson
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.Text as T
+import Data.Text (Text)
+import Text.RawString.QQ
+
+sectionJson :: ByteString
+sectionJson = [r|
+{ "section": {"host": "wikipedia.org"},
+  "whatisit": {"red": "intoothandclaw"}
+}
+|]
+
+data TestData = TestData { section :: Host, what :: Color } deriving (Eq, Show)
+
+instance FromJSON TestData where
+    parseJSON (Object v) =
+        TestData <$> v .: "section"
+                 <*> v .: "whatisit"
+    parseJSON _ = fail "Expected an object for TestData"
+
+newtype Host = Host String deriving (Eq, Show)
+
+instance FromJSON Host where
+    parseJSON (Object v) = 
+        Host <$> v .: "host"
+    parseJSON _ = fail "Expected an object for Host"
+
+type Annotation = String
+
+data Color = Red Annotation
+           | Blue Annotation
+           | Yellow Annotation
+           deriving (Eq, Show)
+
+instance FromJSON Color where
+    parseJSON (Object v) =
+        (Red <$> v .: "red") <|>
+        (Blue <$> v .: "blue") <|>
+        (Yellow <$> v .: "yellow")
+    parseJSON _ = fail "Expected an object for Color"
+
+main :: IO ()
+main = do
+    let d :: Maybe TestData
+        d = decode sectionJson
+    print d

24-parser-combination/src/NumberOrString.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module NumberOrString where
+
+import Control.Applicative
+import Data.Aeson
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.Text as T
+import Data.Text (Text)
+import Text.RawString.QQ
+import Data.Scientific (floatingOrInteger)
+
+data NumberOrString = Numba Integer| Stringy Text deriving (Eq, Show)
+instance FromJSON NumberOrString where
+    parseJSON (Number i) =
+        case floatingOrInteger i of
+            (Left _) -> fail "Must be integral number"
+            (Right integer) -> return $ Numba integer
+    parseJSON (String s) = return $ Stringy s
+    parseJSON _ = fail "NumberOrString must be number or string"
+
+dec :: ByteString -> Maybe NumberOrString
+dec = decode
+
+eitherDec :: ByteString -> Either String NumberOrString
+eitherDec = eitherDecode
+
+main = do
+    print $ dec "blah"
+    print $ eitherDec "blah"

24-parser-combination/src/ParseLog.hs

@@ -0,0 +1,195 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module ParseLog where
+
+import Control.Applicative ((<|>), liftA2)
+import Data.Monoid ((<>))
+import Text.Trifecta
+import Data.Time.Format
+import Data.Time
+import Data.List (intersperse)
+import Text.RawString.QQ
+
+import Test.QuickCheck
+
+data LogEntry = LogEntry TimeOfDay String deriving Eq
+instance Show LogEntry where
+    show (LogEntry t s) =
+        let time = formatTime defaultTimeLocale "%H:%M" t
+        in time ++ " " ++ s
+instance Arbitrary LogEntry where
+    arbitrary = do
+        tod <- TimeOfDay <$> choose (0,23) <*> choose (0,59) <*> pure 0
+        s <- liftA2 (++) 
+                    arbitrary
+                    (oneof [((++) "--") <$> arbitrary, arbitrary]) 
+        return $ LogEntry tod (filter (\c -> c /= '\n') s)
+
+data DayEntry = DayEntry Day [LogEntry] deriving Eq
+instance Show DayEntry where
+    show (DayEntry d es) =
+        let day = formatTime defaultTimeLocale "%Y-%m-%d" d
+            entries = concat . intersperse "\n" . map show $ es
+        in "# " ++ day ++ "\n" ++ entries
+instance Arbitrary DayEntry where
+    arbitrary = do
+        day <- ModifiedJulianDay <$> (2000 +) <$> arbitrary
+        es <- listOf arbitrary
+        return $ DayEntry day es
+
+data Log = Log [DayEntry] deriving Eq
+instance Show Log where
+    show (Log ds) = concat . intersperse "\n\n" . map show $ ds
+instance Arbitrary Log where
+    arbitrary = do
+        es <- listOf arbitrary
+        return $ Log es
+
+countTimeSpentDay :: [LogEntry] -> DiffTime
+countTimeSpentDay [] = 0
+countTimeSpentDay (_:[]) = 0
+countTimeSpentDay (x:y:xs) = 
+    let (LogEntry t1 _) = x
+        (LogEntry t2 _) = y
+    in   (timeOfDayToTime t2) 
+       - (timeOfDayToTime t1) 
+       + (countTimeSpentDay (y:xs))
+
+countDay :: DayEntry -> DiffTime
+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 :: Parser ()
+skipComment = skipMany $ do
+    _ <- count 2 $ char '-'
+    skipMany $ notChar '\n'
+
+skipWhiteSpace :: Parser ()
+skipWhiteSpace = skipMany $ oneOf "\t "
+
+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
+
+
+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
+        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
+        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
+    logEntries <- many parseLogEntry
+    skipBlankLines
+    return $ DayEntry day logEntries 
+
+parseLog :: Parser Log
+parseLog  = do
+    skipBlankLines
+    dayEntries <- many parseDayEntry
+    return $ Log dayEntries
+
+testLog :: String
+testLog = [r|-- wheee a comment
+
+
+# 2025-02-05
+08:00 Breakfast
+09:00 Sanitizing moisture collector
+11:00 Exercising in high-grav gym
+12:00 Lunch
+13:00 Programming
+17:00 Commuting home in rover
+17:30 R&R
+19:00 Dinner
+21:00 Shower
+21:15 Read
+22:00 Sleep
+
+# 2025-02-07 -- dates not nececessarily sequential
+08:00 Breakfast -- should I try skippin bfast?
+09:00 Bumped head, passed out
+13:36 Wake up, headache
+13:37 Go to medbay
+13:40 Patch self up
+13:45 Commute home for rest
+14:15 Read
+21:00 Dinner
+21:15 Read
+22:00 Sleep
+|]
+
+-- Generator for Log files
+genBlankLine :: Gen String
+genBlankLine = oneof [return "\t -- comment!\n", return " \t\n"]
+genDayLine :: Gen String
+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" ] 
+genLogEntry :: Gen String
+genLogEntry = do
+    time <- TimeOfDay <$> choose (0,23) <*> choose (0,59) <*> pure 0
+    let time_string = formatTime defaultTimeLocale "%H:%M" time
+    oneof [ return $ time_string ++ " some description \t \n"
+          , return $ time_string ++ " some description \t -- with comment\n"]
+genDayEntry :: Gen String
+genDayEntry = do
+    day <- genDayLine
+    logEntry <- genLogEntry -- at least one log entry
+    logEntryList <- concat <$> listOf genLogEntry
+    blankLines <- concat <$> listOf genBlankLine
+    return $ day ++  logEntry ++ logEntryList ++ blankLines
+genLog :: Gen String
+genLog = do
+    blankLines <- concat <$> listOf genBlankLine
+    dayEntries <- concat <$> listOf genDayEntry
+    return $ blankLines ++ dayEntries
+
+newtype LogExample = LogExample String deriving (Show)
+instance Arbitrary LogExample where
+    arbitrary = LogExample <$> genLog
+
+propLog :: LogExample -> Bool
+propLog (LogExample s) = case parseString parseLog mempty s of
+    Text.Trifecta.Success _ -> True
+    _ -> False
+
+main :: IO ()
+main = do
+    quickCheck propLog

24-parser-combination/src/PhoneNumber.hs

@@ -0,0 +1,172 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PhoneNumber where
+
+import Control.Applicative ((<|>))
+import Text.Trifecta
+import Test.Hspec
+
+-- 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 
+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 
+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 
+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: 
+04AA/BB BB BB, 04AA/BB.BB.BB or 04AA/BBB.BBB.
+
+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.
+-}
+
+-- see also https://en.wikipedia.org/wiki/Telephone_numbers_in_Belgium
+
+
+-- Will only look at landlines and phonelines
+-- not special numbers or non-geographic numbers
+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 
+                       | 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
+    show (MobileSN (a:b:c:d:e:f:[])) = " " ++ a:b:" " ++ c:d:" " ++ e:f:[]
+    show (MobileSN s) = "Invalid format: " ++ s
+    show (LandTwoSN (a:b:c:d:e:f:[])) = " " ++ a:b:" " ++ c:d:" " ++ e:f:[]
+    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 
+                                                 ++ ")"
+
+
+-- 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]
+        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
+
+parseLandTwoSN :: Parser SubscribersNumber
+parseLandTwoSN = do
+    let p = count 2 digit
+        skip = skipOptional $ char ' ' <|> char '.'
+    p1 <- p
+    skip
+    p2 <- p
+    skip
+    p3 <- p
+    return . LandTwoSN $ p1 ++ p2 ++ p3
+
+parseLandOneSN :: Parser SubscribersNumber
+parseLandOneSN = do
+    let p = count 2 digit
+        skip = skipOptional $ char ' ' <|> char '.'
+    p1 <- count 3 digit
+    skip
+    p2 <- p
+    skip
+    p3 <- p
+    return . LandTwoSN $ p1 ++ p2 ++ p3
+
+parsePhone :: Parser PhoneNumberBE
+parsePhone = do
+    -- Country code
+    m <- optional $ string "+32"
+    -- 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"
+        Nothing -> Just <$> char '0'
+    z <- parseZonePrefix
+    skipOptional $ char ' ' <|> char '/'
+    s <- case z of
+            MobileZP _  -> parseMobileSN
+            LandOneZP _ -> parseLandOneSN
+            LandTwoZP _ -> parseLandTwoSN
+    return $ PhoneNumberBE z s
+    
+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.
+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")
+    -- ...

24-parser-combination/src/PosInt.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PosInt where
+
+import Text.Trifecta
+import Test.Hspec
+
+parseDigit :: Parser Char
+parseDigit = oneOf ['0'..'9']
+
+base10Integer :: Parser Integer
+base10Integer = do
+    xs <- some $ (\a -> read (a:"")) <$> parseDigit
+    return $ 
+      fst $ foldr (\a (b,i) -> (a * i + b, i*10)) (0,1) xs
+
+parseSign :: Parser Char
+parseSign = oneOf ['+', '-']
+
+base10Integer' :: Parser Integer
+base10Integer' = do
+    c <- option '+' parseSign
+    let f =  if c == '-' then negate else id
+    f <$> base10Integer
+
+maybeSuccess :: Result a -> Maybe a
+maybeSuccess (Success a) = Just a
+maybeSuccess _ = Nothing
+
+main :: IO ()
+main = hspec $ do
+    describe "Parse Digit" $ do
+        it "can parse a 0" $ do
+            let m = parseString parseDigit mempty "0"
+                r = maybeSuccess m
+            r `shouldBe` Just '0'
+        it "can parse a 1" $ do
+            let m = parseString parseDigit mempty "1"
+                r = maybeSuccess m
+            r `shouldBe` Just '1'
+        it "can parse a 2" $ do
+            let m = parseString parseDigit mempty "2"
+                r = maybeSuccess m
+            r `shouldBe` Just '2'
+        it "can parse a 3" $ do
+            let m = parseString parseDigit mempty "3"
+                r = maybeSuccess m
+            r `shouldBe` Just '3'
+        it "can parse a 4" $ do
+            let m = parseString parseDigit mempty "4"
+                r = maybeSuccess m
+            r `shouldBe` Just '4'
+        it "can parse a 5" $ do
+            let m = parseString parseDigit mempty "5"
+                r = maybeSuccess m
+            r `shouldBe` Just '5'
+        it "can parse a 6" $ do
+            let m = parseString parseDigit mempty "6"
+                r = maybeSuccess m
+            r `shouldBe` Just '6'
+        it "can parse a 7" $ do
+            let m = parseString parseDigit mempty "7"
+                r = maybeSuccess m
+            r `shouldBe` Just '7'
+        it "can parse a 8" $ do
+            let m = parseString parseDigit mempty "8"
+                r = maybeSuccess m
+            r `shouldBe` Just '8'
+        it "can parse a 9" $ do
+            let m = parseString parseDigit mempty "9"
+                r = maybeSuccess m
+            r `shouldBe` Just '9'
+        it "other values fail" $ 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"
+                r = maybeSuccess m
+            r `shouldBe` Just 3
+        it "can parse multiple digits" $ do
+            let m = parseString base10Integer mempty "123"
+                r = maybeSuccess m
+            r `shouldBe` Just 123
+        it "fails when no digit" $ 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 "-"
+                r = maybeSuccess m
+            r `shouldBe` Just '-'
+        it "Plus" $ do
+            let m = parseString parseSign mempty "+"
+                r = maybeSuccess m
+            r `shouldBe` Just '+'
+        it "other" $ 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"
+                r = maybeSuccess m
+            r `shouldBe` Just 123
+        it "positive with -" $ 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)
+    

24-parser-combination/src/SemVer.hs

@@ -0,0 +1,229 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SemVer where
+
+import Data.Char (isDigit)
+import Text.Trifecta
+import Test.Hspec
+
+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)
+
+-- 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']
+
+validChars :: [Char]
+validChars = ['0'..'9'] ++ ['a'..'z'] ++ ['A'..'Z']
+
+-- According to SemVer identifiers comprise of [0-9a-zA-Z]
+-- Looks like the exercises wants us to differentiate between numbers
+-- and strings, even though it can be mixed: e.g 1.0.0-beta+exp.sha.5114f85
+-- Therefore we will only treat it as a number if the entire identifier can
+-- be identified as a number
+parseNumberOrString :: Parser NumberOrString
+parseNumberOrString = do
+    s <- some $ oneOf validChars
+    return $ if all isDigit s
+             then NOSI (read s)
+             else NOSS s
+
+parserNumberOrStringList :: Parser [NumberOrString]
+parserNumberOrStringList = do
+    x <- parseNumberOrString
+    xs <- many $ char '.' >> parseNumberOrString
+    return $ x : xs
+
+parseRelease :: Parser Release
+parseRelease = char '-' >> parserNumberOrStringList
+
+parseMetadata :: Parser Metadata
+parseMetadata = char '+' >> parserNumberOrStringList
+
+parseSemVer :: Parser SemVer
+parseSemVer = do
+    major <- decimal
+    _ <- char '.'
+    minor <- decimal
+    _ <- char '.'
+    patch <- decimal
+    rel <- option [] parseRelease
+    metadata <- option [] parseMetadata
+    _ <- eof -- not really necessary, but just makes it nice to test :)
+    return $ SemVer major minor patch rel metadata
+
+maybeSuccess :: Result a -> Maybe a
+maybeSuccess (Success a) = Just a
+maybeSuccess _ = Nothing
+
+main :: IO ()
+main = hspec $ do
+    describe "Number or String parsing" $ do
+        it "can parse string" $ do
+            let m = parseString parseNumberOrString mempty "abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (NOSS "abc")
+        it "can parse number" $ do
+            let m = parseString parseNumberOrString mempty "123"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (NOSI 123)
+        it "can parse mixed number and string" $ do
+            let m = parseString parseNumberOrString mempty "123abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (NOSS "123abc")
+        it "fails on non alphanumeric" $ do
+            let m = parseString parseNumberOrString mempty "+"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+
+    describe "Number or String parsing" $ do
+        it "can parse one number or string" $ do
+            let m = parseString parserNumberOrStringList mempty "123abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just [NOSS "123abc"]
+        it "can parse more than one number or string" $ do
+            let m = parseString parserNumberOrStringList mempty "123.abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just [NOSI 123, NOSS "abc"]
+        it "fails when no number or string" $ do
+            let m = parseString parserNumberOrStringList mempty "+"
+                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"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just [NOSI 123, NOSS "abc", NOSS "123abc"]
+        it "fails when doesn't start with '-'" $ do
+            let m = parseString parseRelease mempty "123.abc.123abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+
+    describe "Metadata parsing" $ do
+        it "can parse metadata" $ do
+            let m = parseString parseMetadata mempty "+123.abc.123abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just [NOSI 123, NOSS "abc", NOSS "123abc"]
+        it "fails when doesn't start with '+'" $ do
+            let m = parseString parseRelease mempty "123.abc.123abc"
+                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"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (SemVer 1 2 3 [] [])
+        it "fails on invalid version" $ do
+            let m = parseString parseSemVer mempty "1.2"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "fails with invalid data after version" $ do
+            let m = parseString parseSemVer mempty "1.2.3["
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "can parse with release" $ do
+            let m = parseString parseSemVer mempty "1.2.3-abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (SemVer 1 2 3 [NOSS "abc"] [])
+        it "fails with more than one release" $ do
+            let m = parseString parseSemVer mempty "1.2.3-abc-abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "fails with invalid data after release" $ do
+            let m = parseString parseSemVer mempty "1.2.3-abc]"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "can parse with metadata" $ do
+            let m = parseString parseSemVer mempty "1.2.3+abc"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Just (SemVer 1 2 3 [] [NOSS "abc"])
+        it "fails with more than one metadata" $ do
+            let m = parseString parseSemVer mempty "1.2.3+abc+123"
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "fails with non number or string after release" $ do
+            let m = parseString parseSemVer mempty "1.2.3+abc["
+                r = maybeSuccess m
+            print m
+            r `shouldBe` Nothing
+        it "can parse with release and metadata" $ do
+            let m = parseString parseSemVer mempty "1.2.3-abc+123"
+                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 [] []
+                b = SemVer 1 2 1 [] []
+            compare a b `shouldBe` GT
+        it "Smaller Major" $ do
+            let a = SemVer 1 2 1 [] []
+                b = SemVer 2 1 0 [] []
+            compare a b `shouldBe` LT
+        it "Bigger Minor" $ do
+            let a = SemVer 1 2 0 [] []
+                b = SemVer 1 1 1 [] []
+            compare a b `shouldBe` GT
+        it "Smaller Major" $ do
+            let a = SemVer 1 1 1 [] []
+                b = SemVer 1 2 0 [] []
+            compare a b `shouldBe` LT
+        it "Bigger Patch" $ do
+            let a = SemVer 1 1 2 [] []
+                b = SemVer 1 1 1 [] []
+            compare a b `shouldBe` GT
+        it "Smaller Patch" $ do
+            let a = SemVer 1 1 1 [] []
+                b = SemVer 1 1 2 [] []
+            compare a b `shouldBe` LT
+        it "Equal Patch" $ do
+            let a = SemVer 1 1 1 [] []
+            compare a a `shouldBe` EQ
+        it "Release and Major don't matter" $ do
+            let a = SemVer 1 1 1 [NOSI 3] [NOSI 3]
+                b = SemVer 1 1 1 [NOSI 2, NOSI 1] [NOSI 2, NOSI 1]
+            compare a b `shouldBe` EQ

24-parser-combination/src/TryTry.hs

@@ -0,0 +1,23 @@
+module TryTry where
+
+import Control.Applicative ((<|>))
+import Text.Trifecta
+import Data.Ratio ((%))
+
+parseFraction :: Parser Rational
+parseFraction = do
+    numerator <- decimal
+    char '/'
+    denominator <- decimal
+    case denominator of
+        0 -> fail "Denominator cannot be zero"
+        _ -> return (numerator % denominator)
+
+type DecimalOrFraction = Either Integer Rational
+
+parseDecimalOrFraction :: Parser DecimalOrFraction
+parseDecimalOrFraction = (Right <$> (try parseFraction)) 
+                         <|> (Left <$> decimal)
+
+
+