advent25/src/advent25.hs

   1 -- import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6 import qualified Data.Text as T
   7 import Data.Char
   8 import Data.List
   9 import Control.Monad.Reader
  10
  11 type CachedMachine a = Reader (Machine, [String]) a
  12
  13
  14 main :: IO ()
  15 main = do
  16         text <- TIO.readFile "data/advent25.txt"
  17         let mem = parseMachineMemory text
  18         print $ length mem
  19         (machine, instructions, items) <- runPreamble mem
  20         -- runGameM machine instructions
  21         putStrLn $ passSecurity machine instructions items
  22
  23 runPreamble :: [Integer] -> IO (Machine, [String], [String])
  24 runPreamble mem =
  25       do
  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
  33         -- print items
  34         return (machine, instructions, items)
  35
  36
  37 encodeCommands :: [String] -> [Integer]
  38 -- encodeCommands cmds = map (fromIntegral . ord) $ concat $ map (++ "\n") cmds
  39 encodeCommands = map (fromIntegral . ord) . concat . map (++ "\n")
  40
  41 decodeOutput :: [Integer] -> String
  42 decodeOutput = map (chr . fromIntegral)
  43
  44 extractItems :: String -> [String]
  45 extractItems text = items
  46     where candidates = lines text
  47           items = map (drop 2) $ filter (isPrefixOf "- ") candidates
  48
  49
  50 powerList :: [a] -> [[a]]
  51 powerList [] = [[]]
  52 powerList (x:xs) = powerList xs ++ map (x:) (powerList xs)
  53
  54 passSecurity :: Machine -> [String] -> [String] -> String
  55 passSecurity machine instructions items = "You keep: " ++ (intercalate ", " keeps) ++ "\n\n" ++ successResponse
  56     where
  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
  62
  63 passesSecurity :: [String] -> CachedMachine Bool
  64 passesSecurity drops =
  65     do  output <- attemptSecurity drops
  66         return $ not ("Alert" `isInfixOf` output)
  67
  68 attemptSecurity :: [String] -> CachedMachine String
  69 attemptSecurity drops =
  70     do  let dropCommands = map ("drop " ++ ) drops
  71         output <- runCachedMachine dropCommands
  72         return output
  73
  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
  79
  80
  81
  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
  86
  87 runGame :: [Integer] -> [String] -> IO ()
  88 runGame mem inputs =
  89     do let (_, outputs) = runCommand mem inputs
  90        putStrLn outputs
  91        nextIn <- getLine
  92        runGame mem (inputs ++ [nextIn])
  93
  94 runGameM :: Machine -> [String] -> IO ()
  95 runGameM machine inputs =
  96     do nextIn <- getLine
  97        let (_s, machine1, output1) = runMachine (encodeCommands (inputs ++ [nextIn])) machine
  98        putStrLn $ decodeOutput output1
  99        runGameM machine1 (inputs ++ [nextIn])