diff --git a/Makefile b/Makefile
index 8fe2140..2b2ea3c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-DAY = 4
+DAY = 5
 
 DIR = day$(DAY)
 
diff --git a/day5/main.hs b/day5/main.hs
new file mode 100644
index 0000000..a071431
--- /dev/null
+++ b/day5/main.hs
@@ -0,0 +1,58 @@
+import System.IO
+
+import Data.List
+import Data.List.Split
+
+
+
+
+parseStacks :: [String] -> [[Char]]
+parseStacks = map (filter (/=' ') . init) . transpose . map (map (!!1) . chunksOf 4)
+
+
+parseMove :: String -> (Int,Int,Int)
+parseMove s = (read (x!!1) :: Int, read (x!!3) :: Int, read (x!!5) :: Int)
+    where x = splitOn " " s
+
+
+
+
+applyStacks :: (Int,[Char]) -> (Int,[Char]) -> (Int,[Char]) -> [Char]
+applyStacks (f,fs) (t,ts) (c,cs)
+    | c == f = fs
+    | c == t = ts
+    | otherwise = cs
+
+
+applyMove :: [[Char]] -> (Int,Int,Int) -> [[Char]]
+applyMove acc (n,f,t) = map (applyStacks (f,fromstack) (t,newstack)) $ zip [1..] acc
+    where oldstack = acc !! (f-1)
+          c = take n oldstack
+          fromstack = drop n oldstack
+          tostack = acc !! (t-1)
+          newstack = c ++ tostack
+
+
+applyMoves :: [[Char]] -> (Int,Int,Int) -> [[Char]]
+applyMoves acc (0,_,_)   = acc
+applyMoves acc (n,f,l) = applyMoves (applyMove acc (1,f,l)) (n-1,f,l)
+
+
+
+
+applyMoves2 :: [[Char]] -> (Int,Int,Int) -> [[Char]]
+applyMoves2 acc move = applyMove acc move
+
+
+
+
+handler :: String -> String
+handler s = (show $ map head $ foldl applyMoves stacks moves) ++ "\n" ++
+            (show $ map head $ foldl applyMoves2 stacks moves) ++ "\n"
+    where sections = splitOn [""] $ lines s
+          stacks = parseStacks $ sections !! 0
+          moves  = map parseMove $ sections !! 1
+
+main :: IO ()
+main = do
+    interact handler