diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal
index 9fde23c..66e1475 100644
--- a/advent-of-code-2023.cabal
+++ b/advent-of-code-2023.cabal
@@ -28,3 +28,11 @@ executable day03
     build-depends:    base ^>=4.15.1.0
     hs-source-dirs:   day03
     default-language: Haskell2010
+
+executable day04
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, MissingH
+    hs-source-dirs:   day04
+    default-language: Haskell2010
diff --git a/day04/Commons.hs b/day04/Commons.hs
new file mode 100644
index 0000000..aa0ed49
--- /dev/null
+++ b/day04/Commons.hs
@@ -0,0 +1,28 @@
+module Commons where
+
+import Data.List.Utils (split)
+import GHC.IO.Handle (isEOF)
+
+
+data Card = Card { cid :: Int, nCopies :: Int, winningNumbers :: [Int], numbers :: [Int] } deriving (Show)
+
+
+parseNumbers :: String -> [Int]
+parseNumbers [] = []
+parseNumbers (' ': n1: n2: t) = read [n1, n2]: parseNumbers t
+
+parseCard :: String -> Card
+parseCard ('C': 'a': 'r': 'd': ' ': i1: i2: i3: ':': t) = let (rawWN: rawN: _) = split " |" t
+                                                          in Card {cid = read [i1, i2, i3],
+                                                                   nCopies = 1,
+                                                                   winningNumbers = parseNumbers rawWN,
+                                                                   numbers = parseNumbers rawN}
+
+parse :: IO [Card]
+parse = do done <- isEOF
+           if done
+              then return []
+              else do line <- getLine
+                      let card = parseCard line
+                      otherCards <- parse
+                      return (card: otherCards)
diff --git a/day04/Main.hs b/day04/Main.hs
new file mode 100644
index 0000000..1f2b8eb
--- /dev/null
+++ b/day04/Main.hs
@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do cards <- parse
+          let part1Res = sum (Part1.getAllPoints cards)
+          print part1Res
+          let part2Res = sum (Part2.getNCopies cards)
+          print part2Res
diff --git a/day04/Part1.hs b/day04/Part1.hs
new file mode 100644
index 0000000..f143c69
--- /dev/null
+++ b/day04/Part1.hs
@@ -0,0 +1,18 @@
+module Part1 where
+
+import Commons
+
+
+getNWinningNumbers :: [Int] -> [Int] -> Int
+getNWinningNumbers _ [] = 0
+getNWinningNumbers winningNumbers (n: t) | n `elem` winningNumbers = 1 + getNWinningNumbers winningNumbers t
+                                         | otherwise = getNWinningNumbers winningNumbers t
+
+getPoints :: Card -> Int
+getPoints card = let nWinningNumbers = getNWinningNumbers (winningNumbers card) (numbers card)
+                 in if nWinningNumbers == 0
+                       then 0
+                       else 2 ^ (nWinningNumbers - 1)
+
+getAllPoints :: [Card] -> [Int]
+getAllPoints = map getPoints
diff --git a/day04/Part2.hs b/day04/Part2.hs
new file mode 100644
index 0000000..b940029
--- /dev/null
+++ b/day04/Part2.hs
@@ -0,0 +1,24 @@
+module Part2 where
+
+import Commons
+
+
+getNWinningNumbers :: [Int] -> [Int] -> Int
+getNWinningNumbers _ [] = 0
+getNWinningNumbers winningNumbers (n: t) | n `elem` winningNumbers = 1 + getNWinningNumbers winningNumbers t
+                                         | otherwise = getNWinningNumbers winningNumbers t
+
+updateNCopies :: Int -> Card -> [Card] -> [Card]
+updateNCopies 0 card otherCards = otherCards
+updateNCopies n card (c: t) = c {nCopies = nCopies card + nCopies c}: updateNCopies (n - 1) card t
+
+updateCopies :: Card -> [Card] -> [Card]
+updateCopies card otherCards = let nWinningNumbers = getNWinningNumbers (winningNumbers card) (numbers card)
+                               in updateNCopies nWinningNumbers card otherCards
+
+updateAllCopies :: [Card] -> [Card]
+updateAllCopies [] = []
+updateAllCopies (c: t) = c: updateAllCopies (updateCopies c t)
+
+getNCopies :: [Card] -> [Int]
+getNCopies cards = map nCopies (updateAllCopies cards)