diff --git a/2015/day16/day16.hs b/2015/day16/day16.hs
new file mode 100644
index 0000000..a49c44e
--- /dev/null
+++ b/2015/day16/day16.hs
@@ -0,0 +1,48 @@
+import Aoc
+import Data.List.Split ( splitOn )
+import Data.Char ( isDigit )
+import Control.Arrow ( second )
+import Data.Maybe ( fromMaybe )
+
+parseLine :: String -> (Int, [(String, Int)])
+parseLine line =
+    let ("Sue ", rest0) = splitAt 4 line in
+    let (n, rest1) = span isDigit rest0 in
+    let (':':' ':rest2) = rest1 in
+    let items = splitOn ", " rest2 in
+    (read n, map (second read . pair . splitOn ": ") items)
+
+tape :: [(String, Int)]
+tape = [
+        ("children", 3),
+        ("cats", 7),
+        ("samoyeds", 2),
+        ("pomeranians", 3),
+        ("akitas", 0),
+        ("vizslas", 0),
+        ("goldfish", 5),
+        ("trees", 3),
+        ("cars", 2),
+        ("perfumes", 1)
+    ]
+
+part1' :: (String -> Int -> Int -> Bool) -> [(Int, [(String, Int)])] -> Int
+part1' predicate = fst . single . filter matches
+    where matches (_, items) = all itemMatches tape
+            where  itemMatches (name, n) = case lookup name items of
+                    Nothing -> True
+                    Just n' -> predicate name n' n
+
+part1 :: [(Int, [(String, Int)])] -> Int
+part1 = part1' $ const (==)
+
+part2 :: [(Int, [(String, Int)])] -> Int
+part2 = part1' $ fromMaybe (==) . flip lookup [
+        ("cats", (>)),
+        ("trees", (>)),
+        ("pomeranians", (<)),
+        ("goldfish", (<))
+    ]
+
+main :: IO ()
+main = aocMain (map parseLine) part1 part2
\ No newline at end of file