diff --git a/hs/app/Main.hs b/hs/app/Main.hs
index 9670c05..e9f5019 100644
--- a/hs/app/Main.hs
+++ b/hs/app/Main.hs
@@ -5,6 +5,7 @@ import Options.Applicative
 import Aoc.Y2019.A01
 import Aoc.Y2019.A02
 import Aoc.Y2019.A03
+import Aoc.Y2019.A04
 
 data Settings = Settings
   { function :: FilePath -> IO ()
@@ -16,6 +17,7 @@ solutions = subparser $ mconcat $ map (\(name, func) -> command name (info (pure
   [ ("2019_01", solve201901)
   , ("2019_02", solve201902)
   , ("2019_03", solve201903)
+  , ("2019_04", solve201904)
   ]
 
 parser :: Parser Settings
diff --git a/hs/src/Aoc/Y2019/A04.hs b/hs/src/Aoc/Y2019/A04.hs
new file mode 100644
index 0000000..af88c35
--- /dev/null
+++ b/hs/src/Aoc/Y2019/A04.hs
@@ -0,0 +1,39 @@
+module Aoc.Y2019.A04
+  ( solve201904
+  ) where
+
+type Passwd = (Int, Int, Int, Int, Int, Int)
+
+passwds :: [Passwd]
+passwds = do
+  a <- [1..9]
+  b <- [a..9]
+  c <- [b..9]
+  d <- [c..9]
+  e <- [d..9]
+  f <- [e..9]
+  pure (a, b, c, d, e, f)
+
+getRange :: Passwd -> Passwd -> [Passwd]
+getRange lowerBound upperBound = takeWhile (<=upperBound) $ dropWhile (<lowerBound) passwds
+
+passwdsInRange :: [Passwd]
+passwdsInRange = getRange (1,3,6,8,1,8) (6,8,5,9,7,9)
+
+seqDigits :: Passwd -> Bool
+seqDigits (a, b, c, d, e, f) = or $ zipWith (==) [a,b,c,d,e] [b,c,d,e,f]
+
+sepSeqDigits :: Passwd -> Bool
+sepSeqDigits (a, b, c, d, e, f) =
+  let leftEdge  = zipWith (/=) [0,a,b,c,d] [a,b,c,d,e]
+      pair      = zipWith (==) [a,b,c,d,e] [b,c,d,e,f]
+      rightEdge = zipWith (/=) [b,c,d,e,f] [c,d,e,f,0]
+  in  or $ zipWith3 (\x y z -> x && y && z) leftEdge pair rightEdge
+
+solve201904 :: FilePath -> IO ()
+solve201904 _ = do
+  putStrLn ">> Part 1"
+  print $ length $ filter seqDigits passwdsInRange
+
+  putStrLn ">> Part 2"
+  print $ length $ filter sepSeqDigits passwdsInRange