diff --git a/2023/04/Day04.cabal b/2023/04/Day04.cabal
new file mode 100644
index 0000000..4b300a7
--- /dev/null
+++ b/2023/04/Day04.cabal
@@ -0,0 +1,19 @@
+cabal-version:   3.0
+name:            Day04
+version:         0.1.0.0
+license:         NONE
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable Day04
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:    base ^>=4.17.2.1
+                    , attoparsec ^>=0.14.4
+                    , text ^>=2.1
+                    , containers ^>=0.6.7
+    hs-source-dirs:   app
+    default-language: Haskell2010
diff --git a/2023/04/app/Main.hs b/2023/04/app/Main.hs
new file mode 100644
index 0000000..115636b
--- /dev/null
+++ b/2023/04/app/Main.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Data.Char (isDigit)
+import Data.Map (fromList, member, (!))
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import Data.Attoparsec.Text
+
+type WinningNumbers = [Integer]
+type MyNumbers = [Integer]
+type Game = (Integer, WinningNumbers, MyNumbers)
+type Input = [Game]
+
+main :: IO ()
+main = do
+  input <- parseInput <$> TIO.getContents
+  putStrLn ("Part 1: " <> show (part1 input))
+  putStrLn ("Part 2: " <> show (part2 input))
+
+parseInput :: T.Text -> Input
+parseInput s = case parseOnly inputParser s of
+  Right i -> i
+  Left e -> error e
+
+part1 :: Input -> Int
+part1 gs = sum $ map cardValue gs
+
+cardValue :: Game -> Int
+cardValue = value . winCount
+  where
+    value 0 = 0
+    value n = 2 ^ (n - 1)
+
+part2 :: Input -> Int
+part2 games = walkCards $ zip [0..] $ map winCount games
+
+walkCards :: [(Int, Int)] -> Int
+walkCards x = walkCards' (map fst x) 0
+  where
+    walkCards' [] acc = acc
+    walkCards' (id:xs) acc = walkCards' xs (acc + walkCards' (additional id) 1)
+    additional id = [next | n <- [1..(winCounts ! id)], let next = id + n, next <= lastId]
+    winCounts = fromList x
+    lastId = fst $ last x
+
+winCount :: Game -> Int
+winCount (_, ws, ms) = length $ filter (`elem` ws) ms
+
+inputParser :: Parser Input
+inputParser = sepBy1 gameParser endOfLine <* skipSpace <* endOfInput
+
+gameParser :: Parser Game
+gameParser = do
+  string "Card"
+  skipSpace
+  id <- decimal
+  string ": "
+  winning <- parseNumberList
+  string " | "
+  my <- parseNumberList
+  return (id, winning, my)
+
+parseNumberList :: Parser [Integer]
+parseNumberList = sepBy1 (skipSpace *> decimal) " "
diff --git a/2023/04/example b/2023/04/example
new file mode 100644
index 0000000..9bdb874
--- /dev/null
+++ b/2023/04/example
@@ -0,0 +1,6 @@
+Card 1: 41 48 83 86 17 | 83 86  6 31 17  9 48 53
+Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19
+Card 3:  1 21 53 59 44 | 69 82 63 72 16 21 14  1
+Card 4: 41 92 73 84 69 | 59 84 76 51 58  5 54 83
+Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36
+Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11