1 import Text.Parsec hiding (State)
2 import Text.ParserCombinators.Parsec.Number
3 -- import Control.Applicative ((<*), (*>), (<*>))
4 import Data.Maybe (fromJust)
5 import Data.List (elemIndex)
7 import Control.Monad.Identity
8 import Control.Monad.State
9 import Control.Monad.Writer
11 data Instruction = SwapPosition Int Int
12 | SwapLetter Char Char
23 data Password = Password {
28 type App = WriterT [Log] (StateT Password Identity)
32 (??) :: Eq a => [a] -> a -> Int
33 (??) items item = fromJust $ elemIndex item items
40 \swap position 4 with position 0\n\
41 \swap letter d with letter b\n\
42 \reverse positions 0 through 4\n\
43 \rotate left 1 step\n\
44 \move position 1 to position 4\n\
45 \move position 3 to position 0\n\
46 \rotate based on position of letter b\n\
47 \rotate based on position of letter d\n"
51 -- let ti = successfulParse $ parseIfile testInstructions
53 -- part2 (reverse ti) "decab"
54 text <- readFile "advent21.txt"
55 let instructions = successfulParse $ parseIfile text
56 part1 instructions initial
57 part2 (reverse instructions) final
59 part1 :: [Instruction] -> String -> IO ()
60 part1 instructions start =
61 let state = Password {password = start}
62 in print $ runIdentity (runStateT (runWriterT (apply instructions)) state)
63 -- in putStrLn $ password $ runIdentity (execStateT (runWriterT (apply instructions)) state)
65 part2 :: [Instruction] -> String -> IO ()
66 part2 instructions end =
67 let state = Password {password = end}
68 in print $ runIdentity (runStateT (runWriterT (unApply instructions)) state)
69 -- in putStrLn $ password $ runIdentity (execStateT (runWriterT (apply instructions)) state)
72 apply :: [Instruction] -> App ()
77 let p1 = applyInstruction i p0
78 put st {password = p1}
79 tell [Log (p0 ++ " -> " ++ p1 ++ " : " ++ (show i))]
83 applyInstruction :: Instruction -> String -> String
84 applyInstruction (SwapPosition from to) p0
86 | otherwise = prefix ++ [p0!!end] ++ midfix ++ [p0!!start] ++ suffix
87 where start = minimum [from, to]
88 end = maximum [from, to]
89 prefix = take start p0
90 midfix = take (end-start-1) $ drop (start+1) p0
91 suffix = drop (end+1) p0
93 applyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapPosition (p0??l0) (p0??l1)) p0
95 applyInstruction (RotateSteps n) p0 = (drop n' p0) ++ (take n' p0)
100 applyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
101 where n = (1 + (p0??l) + if (p0??l) >= 4 then 1 else 0) `mod` (length p0)
103 applyInstruction (Reverse from to) p0
105 | otherwise = prefix ++ (reverse midfix) ++ suffix
106 where start = minimum [from, to]
107 end = maximum [from, to]
108 prefix = take start p0
109 midfix = take (end-start+1) $ drop start p0
110 suffix = drop (end+1) p0
112 applyInstruction (Move from to) p0
114 | otherwise = prefix ++ [p0!!from] ++ suffix
115 where without = take from p0 ++ drop (from+1) p0
116 prefix = take to without
117 suffix = drop (to) without
120 unApply :: [Instruction] -> App ()
121 unApply [] = return ()
125 let p1 = unApplyInstruction i p0
126 put st {password = p1}
127 tell [Log (p1 ++ " <- " ++ p0 ++ " : " ++ (show i))]
130 unApplyInstruction :: Instruction -> String -> String
131 unApplyInstruction (SwapPosition from to) p0 = applyInstruction (SwapPosition from to) p0
132 unApplyInstruction (SwapLetter l0 l1) p0 = applyInstruction (SwapLetter l0 l1) p0
133 unApplyInstruction (RotateSteps n) p0 = applyInstruction (RotateSteps (-1 * n)) p0
134 unApplyInstruction (Reverse from to) p0 = applyInstruction (Reverse from to) p0
135 unApplyInstruction (Move from to) p0 = applyInstruction (Move to from) p0
136 unApplyInstruction (RotateLetter l) p0 = applyInstruction (RotateSteps n) p0
137 where n = case (p0??l) of
146 -- where n = case (p0??l) of
154 instructionFile = instructionLine `endBy` newline
155 instructionLine = choice [ swapL
161 swapL = (try (string "swap ")) *> (swapPosL <|> swapLetterL)
163 swapPosL = SwapPosition <$> (string "position" *> spaces *> int)
164 <*> (spaces *> string "with position" *> spaces *> int)
166 swapLetterL = SwapLetter <$> (string "letter" *> spaces *> letter)
167 <*> (spaces *> string "with letter" *> spaces *> letter)
169 rotateL = (try (string "rotate ")) *> (rotateDirL <|> rotateLetterL)
171 rotateDirL = rotateStepify <$> ((string "left") <|> (string "right"))
172 <*> (spaces *> int <* spaces <* skipMany letter)
173 where rotateStepify dir n = case dir of
174 "left" -> (RotateSteps (-1 * n))
175 "right" -> (RotateSteps n)
176 rotateLetterL = RotateLetter <$> (string "based on position of letter " *> letter)
178 reverseL = Reverse <$> (string "reverse positions" *> spaces *> int)
179 <*> (spaces *> (string "through") *> spaces *> int)
181 moveL = Move <$> (string "move position" *> spaces *> int)
182 <*> (spaces *> (string "to position") *> spaces *> int)
185 parseIfile :: String -> Either ParseError [Instruction]
186 parseIfile input = parse instructionFile "(unknown)" input
188 parseIline :: String -> Either ParseError Instruction
189 parseIline input = parse instructionLine "(unknown)" input
191 successfulParse :: Either ParseError [a] -> [a]
192 successfulParse (Left _) = []
193 successfulParse (Right a) = a