Now uses a Reader monad

diff --git a/advent25/package.yaml b/advent25/package.yaml
index 2df182222ab647f7898019a60eb5ed5b5ce946a2..c8c4d8a6f7df3a61493a055dafd1a9152004ccdb 100644 (file)
--- a/advent25/package.yaml
+++ b/advent25/package.yaml
@@ -58,3 +58,4 @@ executables:
     - text
     - containers
     - intcode
     - text
     - containers
     - intcode

+    - mtl

diff --git a/advent25/src/advent25.hs b/advent25/src/advent25.hs
index 126fbc8f604f2fd63a40ece46f4fa89a8bb53c2f..c9a74573d6cd867e108992c143243026fd9ed9db 100644 (file)
--- a/advent25/src/advent25.hs
+++ b/advent25/src/advent25.hs
@@ -6,6 +6,10 @@ import qualified Data.Text.IO as TIO
 import qualified Data.Text as T
 import Data.Char
 import Data.List
 import qualified Data.Text as T
 import Data.Char
 import Data.List

+import Control.Monad.Reader
+
+type CachedMachine a = Reader (Machine, [String]) a
+

 
 main :: IO ()
 main = do 
 
 main :: IO ()
 main = do 


@@ -48,21 +52,32 @@ powerList [] = [[]]
 powerList (x:xs) = powerList xs ++ map (x:) (powerList xs) 
 
 passSecurity :: Machine -> [String] -> [String] -> String
 powerList (x:xs) = powerList xs ++ map (x:) (powerList xs) 
 
 passSecurity :: Machine -> [String] -> [String] -> String

-passSecurity machine instructions items = 
-    "You keep: " ++ (intercalate ", " keeps) ++ "\n\n" ++ (attemptSecurity machine instructions validDropset)
+passSecurity machine instructions items = "You keep: " ++ (intercalate ", " keeps) ++ "\n\n" ++ successResponse

     where
     where

+        env = (machine, instructions)

         dropsets = powerList items
         dropsets = powerList items

-        validDropset = head $ filter (passesSecurity machine instructions) dropsets
+        validDropset = head $ filter (\ds -> runReader (passesSecurity ds) env) dropsets
+        successResponse = (runReader (attemptSecurity validDropset) env)

         keeps = items \\ validDropset
 
         keeps = items \\ validDropset
 

-passesSecurity :: Machine -> [String] -> [String] -> Bool
-passesSecurity machine instructions drops = not ("Alert" `isInfixOf` output)
-    where output = attemptSecurity machine instructions drops
+passesSecurity :: [String] -> CachedMachine Bool
+passesSecurity drops = 
+    do  output <- attemptSecurity drops
+        return $ not ("Alert" `isInfixOf` output)
+
+attemptSecurity :: [String] -> CachedMachine String
+attemptSecurity drops = 
+    do  let dropCommands = map ("drop " ++ ) drops
+        output <- runCachedMachine dropCommands
+        return output 
+
+runCachedMachine :: [String] -> CachedMachine String
+runCachedMachine dropCommands =
+    do (machine, instructions) <- ask
+       let (_, _, output) = runMachine (encodeCommands (instructions ++ dropCommands ++ ["north"])) machine
+       return $ decodeOutput output
+

 
 

-attemptSecurity :: Machine -> [String] -> [String] -> String
-attemptSecurity machine instructions drops = decodeOutput output
-    where dropCommands = map ("drop " ++ ) drops
-          (_, _, output) = runMachine (encodeCommands (instructions ++ dropCommands ++ ["north"])) machine

 
 runCommand :: [Integer] -> [String] -> (Machine, String)
 runCommand mem inputs = ( machine, decodeOutput output )
 
 runCommand :: [Integer] -> [String] -> (Machine, String)
 runCommand mem inputs = ( machine, decodeOutput output )