diff --git a/Makefile b/Makefile
index e9df72a..fb4fd0b 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-DAY = 8
+DAY = 9
 
 DIR = day$(DAY)
 
diff --git a/day9/main.hs b/day9/main.hs
new file mode 100644
index 0000000..b5ab05d
--- /dev/null
+++ b/day9/main.hs
@@ -0,0 +1,96 @@
+import System.IO
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Data.Char (ord,chr)
+
+import Debug.Trace
+
+
+type Pos = (Int,Int)
+
+
+
+
+ppinsert :: Char -> [Pos] -> ([String],Int,Int) -> [String]
+ppinsert _ [] (b,_,_) = b
+ppinsert id ((x,y):xs) d@(b,minx,miny) = nbrd
+    where
+        nextid
+            | id == '#' = '#'
+            | id == 'H' = '1'
+            | otherwise = chr $ (ord id)+1
+        (brows,(orow:arows)) = splitAt (y-miny) $ ppinsert nextid xs d
+        (bchars,(_:achars)) = splitAt (x-minx) orow
+        nrow = bchars ++ [id] ++ achars
+        nbrd = brows ++ [nrow] ++ arows
+
+
+ppp :: Char -> [Pos] -> String
+ppp h l = concat $ reverse $ ppinsert h l (start,minx,miny)
+    where
+        (x,y) = unzip l
+        minx  = min (-10) (minimum x)
+        miny  = min (-5) (minimum y)
+        maxx  = max 10 (maximum x)
+        maxy  = max 5 (maximum y)
+        srow  = replicate (-minx) '.' ++ "s" ++ replicate maxx '.' ++ "\n"
+        brow  = replicate (-minx) '.' ++ "." ++ replicate maxx '.' ++ "\n"
+        start = replicate (-miny) brow ++ [srow] ++ replicate maxy brow
+
+
+
+
+parseMove :: String -> [Pos]
+parseMove s = replicate n dv
+    where
+        d  = head s
+        n  = read (drop 2 s) :: Int
+        dv = case d of 'U' -> (0,1)
+                       'R' -> (1,0)
+                       'D' -> (0,-1)
+                       'L' -> (-1,0)
+
+parseMoves :: String -> [Pos]
+parseMoves = concat . map parseMove . lines
+
+
+
+
+dragTail :: [Pos] -> [Pos]
+dragTail [t] = [t]
+dragTail l@( h@(hx,hy) : (nx,ny) : xs)
+    | dx > 1    = (h : dragTail ((nx+1  ,ny+dyu) : xs))
+    | dy > 1    = (h : dragTail ((nx+dxu,ny+1  ) : xs))
+    | dx < -1   = (h : dragTail ((nx-1  ,ny+dyu) : xs))
+    | dy < -1   = (h : dragTail ((nx+dxu,ny-1  ) : xs))
+    | otherwise = l
+    where
+        (dx,dy) = (hx-nx,hy-ny)
+        (dxu,dyu) = (signum dx,signum dy)
+
+sim :: (Set Pos,[Pos]) -> Pos -> (Set Pos,[Pos])
+sim (s,((hx,hy):t)) (dx,dy) = (ns,nl) -- trace (ppp 'H' nl)
+    where
+        nh = (hx+dx,hy+dy)
+        nl = dragTail (nh:t)
+        ns = Set.insert (last nl) s
+
+
+
+
+handler :: String -> String
+handler s = (show $ Set.size trail2) ++ "\n" ++
+            (show $ Set.size trail10) ++ "\n"
+    where
+        moves = parseMoves s
+        start2 = (Set.empty,[(0,0),(0,0)])
+        start10 = (Set.empty,replicate 10 (0,0))
+        (trail2,_) = foldl sim start2 $ moves
+        (trail10,_) = foldl sim start10 $ moves
+
+main :: IO ()
+main = do
+    interact handler
+