diff --git a/day10.hs b/day10.hs
new file mode 100644
index 0000000..799dce4
--- /dev/null
+++ b/day10.hs
@@ -0,0 +1,51 @@
+import Data.List (sort, subsequences)
+
+main :: IO ()
+main = do
+  raw <- readFile "day10.txt"
+  let nums = (map read $ lines raw) :: [Int]
+      ansA = solveA nums
+      ansB = solveB nums
+   in do
+     putStrLn $ "day10a: " ++ (show ansA)
+     putStrLn $ "day10b: " ++ (show ansB)
+
+solveA :: [Int] -> Int
+solveA nums = (filt 3 ls) * (filt 1 ls)
+  where
+    filt a = length . (filter (== a))
+    end = 3 + (maximum nums)
+    ls = (diffs . sort) (0 : end : nums)
+
+solveB :: [Int] -> Int
+solveB nums = unLookup 0 $ loeb $ map (loebify ls m) ls
+  where
+    unLookup a ns = unMaybe $ lookup a ns
+    ls = sort $ 0 : ((maximum nums) + 3) : nums
+    m = (maximum nums + 3)
+
+diffs :: [Int] -> [Int]
+diffs [] = []
+diffs [a] = []
+diffs (a:b:xs) = (b-a):(diffs (b:xs))
+
+loeb :: Functor f => f (f a -> a) -> f a
+loeb x = go
+  where
+    go = fmap ($ go) x
+
+loebify :: [Int] -> Int -> Int -> [(Int, Int)] -> (Int, Int)
+loebify nums m t =
+  if t == m
+  then (\ls -> (t, 1))
+  else (\ls -> (t, sum [ f ls | f <- links ]))
+  where
+    vals = takeWhile (<= (t + 3)) $ dropWhile (<= t) nums
+    links = map lookupify vals
+
+lookupify :: Eq a => a -> [(a,b)] -> b
+lookupify k = unMaybe . (lookup k)
+
+unMaybe :: Maybe a -> a
+unMaybe Nothing = error "invalid key"
+unMaybe (Just v) = v
diff --git a/day10.txt b/day10.txt
new file mode 100644
index 0000000..165ad96
--- /dev/null
+++ b/day10.txt
@@ -0,0 +1,103 @@
+73
+114
+100
+122
+10
+141
+89
+70
+134
+2
+116
+30
+123
+81
+104
+42
+142
+26
+15
+92
+56
+60
+3
+151
+11
+129
+167
+76
+18
+78
+32
+110
+8
+119
+164
+143
+87
+4
+9
+107
+130
+19
+52
+84
+55
+69
+71
+83
+165
+72
+156
+41
+40
+1
+61
+158
+27
+31
+155
+25
+93
+166
+59
+108
+98
+149
+124
+65
+77
+88
+46
+14
+64
+39
+140
+95
+113
+54
+66
+137
+101
+22
+82
+21
+131
+109
+45
+150
+94
+36
+20
+33
+49
+146
+157
+99
+7
+53
+161
+115
+127
+152
+128