5 import qualified Data.Text.IO as TIO
6 import qualified Data.Text as T
9 import Control.Monad.Reader
11 type CachedMachine a = Reader (Machine, [String]) a
16 text <- TIO.readFile "data/advent25.txt"
17 let mem = parseMachineMemory text
19 (machine, instructions, items) <- runPreamble mem
20 -- runGameM machine instructions
21 putStrLn $ passSecurity machine instructions items
23 runPreamble :: [Integer] -> IO (Machine, [String], [String])
26 instr <- TIO.readFile "data/advent25-instructions.txt"
27 let instructions = lines $ T.unpack instr
28 -- runGame mem $ lines $ T.unpack instructions
29 let (machine, _output) = runCommand mem instructions
30 let (_s, _machine1, output1) = runMachine (encodeCommands (instructions ++ ["inv"])) machine
31 putStrLn $ decodeOutput output1
32 let items = extractItems $ decodeOutput output1
34 return (machine, instructions, items)
37 encodeCommands :: [String] -> [Integer]
38 -- encodeCommands cmds = map (fromIntegral . ord) $ concat $ map (++ "\n") cmds
39 encodeCommands = map (fromIntegral . ord) . concat . map (++ "\n")
41 decodeOutput :: [Integer] -> String
42 decodeOutput = map (chr . fromIntegral)
44 extractItems :: String -> [String]
45 extractItems text = items
46 where candidates = lines text
47 items = map (drop 2) $ filter (isPrefixOf "- ") candidates
50 powerList :: [a] -> [[a]]
52 powerList (x:xs) = powerList xs ++ map (x:) (powerList xs)
54 passSecurity :: Machine -> [String] -> [String] -> String
55 passSecurity machine instructions items = "You keep: " ++ (intercalate ", " keeps) ++ "\n\n" ++ successResponse
57 env = (machine, instructions)
58 dropsets = powerList items
59 validDropset = head $ filter (\ds -> runReader (passesSecurity ds) env) dropsets
60 successResponse = (runReader (attemptSecurity validDropset) env)
61 keeps = items \\ validDropset
63 passesSecurity :: [String] -> CachedMachine Bool
64 passesSecurity drops =
65 do output <- attemptSecurity drops
66 return $ not ("Alert" `isInfixOf` output)
68 attemptSecurity :: [String] -> CachedMachine String
69 attemptSecurity drops =
70 do let dropCommands = map ("drop " ++ ) drops
71 output <- runCachedMachine dropCommands
74 runCachedMachine :: [String] -> CachedMachine String
75 runCachedMachine dropCommands =
76 do (machine, instructions) <- ask
77 let (_, _, output) = runMachine (encodeCommands (instructions ++ dropCommands ++ ["north"])) machine
78 return $ decodeOutput output
82 runCommand :: [Integer] -> [String] -> (Machine, String)
83 runCommand mem inputs = ( machine, decodeOutput output )
84 where (_state, machine, output) = runProgram inputCodes mem
85 inputCodes = encodeCommands inputs
87 runGame :: [Integer] -> [String] -> IO ()
89 do let (_, outputs) = runCommand mem inputs
92 runGame mem (inputs ++ [nextIn])
94 runGameM :: Machine -> [String] -> IO ()
95 runGameM machine inputs =
97 let (_s, machine1, output1) = runMachine (encodeCommands (inputs ++ [nextIn])) machine
98 putStrLn $ decodeOutput output1
99 runGameM machine1 (inputs ++ [nextIn])