diff --git a/2022/day11/day11.hs b/2022/day11/day11.hs
index fbbcf1d..46dbd51 100644
--- a/2022/day11/day11.hs
+++ b/2022/day11/day11.hs
@@ -9,7 +9,7 @@ data Monkey =
     { mID :: Int
     , _items :: [Int]
     , operation :: Int -> Int
-    , test :: Int -> Bool
+    , test :: Int
     , nextMonkey :: (Int, Int)
     , _inspectCounter :: Int
     }
@@ -35,7 +35,12 @@ main :: IO ()
 main = do
   input <- map (map (splitOn ":") . lines) . splitOn "\n\n" <$> readFile "input"
   let monkes = mapMaybe parseMonkey input
-  print $ product $ take 2 $ reverse $ sort $ map _inspectCounter $ last $ take 21 $ iterate turns monkes
+  print $ day11 20 (`div` 3) monkes
+  print $ day11 10000 id monkes
+
+day11 :: Int -> (Int -> Int) -> [Monkey] -> Int
+day11 x f m = g $ take (succ x) $ iterate (turns f) m
+    where g = product . take 2 . reverse . sort . map _inspectCounter . last
 
 parseMonkey :: [[String]] -> Maybe Monkey
 parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
@@ -44,29 +49,29 @@ parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
     (f' a)
     (read ('[' : b ++ "]"))
     (parseOP $ words c)
-    (mtest $ read $ last $ words d)
+    (f' d)
     (f' e, f' f)
     0
   where
     f' = read . last . words
-    mtest x y = y `mod` x == 0
     parseOP [_, _, _, x, y]
-      | y == "old" = (^ 2)
+      | y == "old" = (^ (2::Int))
       | x == "*" = (*) (read y)
       | otherwise = (+) (read y)
 parseMonkey _ = Nothing
 
-turns :: [Monkey] -> [Monkey]
-turns = turns' 0
+turns :: (Int -> Int) -> [Monkey] -> [Monkey]
+turns f = turns' 0
     where turns' n ms
             | length ms == n = ms
             | otherwise = turns' (succ n) monkeNew
-                where itemsNew = [ flip div 3 $ operation (ms !! n) x  | x<-_items (ms !! n)]
+                where itemsNew = [ f $ flip mod modNum $ operation (ms !! n) x  | x<-_items (ms !! n)]
                       monkeEmptied = ms & ix n .~ ((ms !! n) & items .~ [] & inspectCounter +~ length itemsNew)
                       monkeNew = monkeThrow itemsNew n monkeEmptied
+                      modNum = foldl1 lcm $ map test ms
 
 monkeThrow :: [Int] -> Int -> [Monkey] -> [Monkey]
 monkeThrow (x:xs) n ms = monkeThrow xs n (ms & ix next .~ ((ms !! next) & items .~ (_items (ms !! next) ++ [x]) ))
-    where next = if test (ms !! n) x then fst targets else snd targets
+    where next = if mod x (test (ms !! n)) == 0 then fst targets else snd targets
           targets = nextMonkey (ms !! n)
 monkeThrow _ _ ms = ms