diff --git a/Day14/Common.hs b/Day14/Common.hs
new file mode 100755
index 0000000..2ea671b
--- /dev/null
+++ b/Day14/Common.hs
@@ -0,0 +1,33 @@
+module Common where
+
+import Data.Function (fix)
+import Data.Word
+import qualified Data.List as L
+
+input :: Num a => a
+input = 170641
+
+scores :: () -> [Word8]
+scores () = fix $ \ss ->
+   3 : 7 : concat (L.unfoldr (Just . step (quickLookup ss)) (0, 1, 2))
+
+digits :: Num a => Int -> [a]
+digits = map (\c -> fromIntegral (fromEnum c - fromEnum '0')) . show
+
+step :: (Int -> Word8) -> (Int, Int, Int) -> ([Word8], (Int, Int, Int))
+step ss (a, b, n) = (rs, (a', b', n'))
+   where
+      sa = fromIntegral (ss a)
+      sb = fromIntegral (ss b)
+      rs = digits (sa + sb)
+      n' = n + length rs
+      a' = (a + 1 + sa) `mod` n'
+      b' = (b + 1 + sb) `mod` n'
+
+quickLookup :: [a] -> Int -> a
+quickLookup xs = \n -> if n < 10 then xs !! n
+                       else (nextLevel (n `div` 10)) !! (n `mod` 10)
+   where
+      nextLevel = quickLookup $ decimate $ L.tails xs
+      decimate [] = []
+      decimate xs = let (as, bs) = splitAt 10 xs in head as : decimate bs
diff --git a/Day14/Part1.hs b/Day14/Part1.hs
new file mode 100755
index 0000000..5ed1812
--- /dev/null
+++ b/Day14/Part1.hs
@@ -0,0 +1,5 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+module Main where
+import Common
+main = print $ take 10 $ drop input $ scores ()
diff --git a/Day14/Part2.hs b/Day14/Part2.hs
new file mode 100755
index 0000000..bc65107
--- /dev/null
+++ b/Day14/Part2.hs
@@ -0,0 +1,11 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+module Main where
+
+import Common
+import Data.List (tails)
+
+main = print $ fst $ head
+     $ dropWhile ((/= inputDigits) . take (length inputDigits) . snd)
+     $ zip [0..] $ tails $ scores ()
+   where inputDigits = digits input