content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeApplications  #-}
  
  -- |
  -- Module      : AOC.Challenge.Day21
  -- License     : BSD3
  --
  -- Stability   : experimental
  -- Portability : non-portable
  --
  -- Day 21.  See "AOC.Solver" for the types used in this module!
  
  module AOC.Challenge.Day21 (
      day21a
    , day21b
    ) where
  
  import           AOC.Common                (_CharFinite)
  import           AOC.Common.Intcode        (Memory, parseMem, untilHalt, stepForever, IErr, preAscii)
  import           AOC.Solver                ((:~>)(..))
  import           Control.Applicative       (empty)
  import           Control.Lens              (review)
  import           Control.Monad             ((<=<))
  import           Data.Char                 (ord)
  import           Data.Conduino             (Pipe, runPipe, (.|), yield)
  import           Data.Finite               (Finite, weakenN)
  import           Data.List                 (find)
  import           Data.Text                 (Text)
  import           Data.Void                 (Void)
  import           Text.Printf               (printf)
  import qualified Data.Conduino.Combinators as C
  import qualified Data.Text                 as T
  
  
  data Reg = RTemp | RJump | RInp (Finite 9)
    deriving (Eq, Ord, Show)
  
  data Com = CAnd | COr | CNot
    deriving (Eq, Ord, Show)
  
  data Instr = I Com Reg Reg
    deriving (Eq, Ord, Show)
  
  type Program = [Instr]
  
  runSpringbot
      :: Monad m
      => Pipe () Text u m Void
      -> Memory
      -> m [Int]
  runSpringbot src m = runPipe $ src
                              .| preAscii
                              .| untilHalt (stepForever @IErr m)
                              .| C.sinkList
  
  sourceWalk :: Program -> Pipe i Text u m ()
  sourceWalk p = do
      C.sourceList (instrCode <$> p)
      yield "WALK"
  
  theProg :: Program
  theProg = [
        I COr (RInp 3) RJump      -- jump if target is stable
      , I CNot RTemp RTemp        -- RTemp == True
      , I CAnd (RInp 0) RTemp     -- RTemp &&= r0
      , I CAnd (RInp 1) RTemp     -- RTemp &&= r1
      , I CAnd (RInp 2) RTemp     -- RTemp &&= r2
      , I CNot RTemp RTemp        -- then don't jump
      , I CAnd RTemp RJump
      ]
  
  -- the logic:
  --
  -- jump whenever it is safe to do so.  but don't jump frivolously (if there
  -- is no hole in sight)
  --
  -- 0 ####   No
  -- 1 ###.   No
  -- 2 ##.#   Yes
  -- 3 ##..   No
  -- 4 #.##   Yes
  -- 5 #.#.   No
  -- 6 #..#   Yes
  -- 7 #...   No
  -- 8 .###   Yes
  -- 9 .##.   Give Up
  -- a .#.#   Yes
  -- b .#..   Give Up
  -- c ..##   Yes
  -- d ..#.   Give Up
  -- e ...#   Yes
  -- f ....   Give Up
  --
  
  day21a :: Memory :~> Int
  day21a = MkSol
      { sParse = parseMem
      , sShow  = show
      , sSolve = isGood <=< runSpringbot (sourceWalk theProg *> empty)
      }
  
  sourceRun :: Program -> Pipe i Text u m ()
  sourceRun p = do
      C.sourceList (instrCode <$> p)
      yield "RUN"
  
  -- the logic:
  --
  -- the same but also try to 'double jump' if you can.
  theProg2 :: Program
  theProg2 = [
        I CNot (RInp 0) RJump     -- jump if next spot is bad
      , I COr  (RInp 3) RTemp      -- jump if target is stable
      , I CAnd (RInp 7) RTemp      --   and double-target is stable
      , I COr  RTemp    RJump
      , I CNot (RInp 0) RTemp
      , I CNot RTemp    RTemp
      , I CAnd (RInp 1) RTemp     -- RTemp &&= r1
      , I CAnd (RInp 2) RTemp     -- RTemp &&= r2
      , I CNot RTemp RTemp        -- then don't jump
      , I CAnd RTemp RJump
      ]
  
  
  day21b :: Memory :~> Int
  day21b = MkSol
      { sParse = parseMem
      , sShow  = show
      , sSolve = isGood <=< runSpringbot (sourceRun theProg2 *> empty)
      }
  
  isGood :: [Int] -> Maybe Int
  isGood = find (> ord maxBound)
  
  regCode :: Reg -> Char
  regCode = \case
      RTemp -> 'T'
      RJump -> 'J'
      RInp c -> review _CharFinite (True, weakenN c)
  
  comCode :: Com -> String
  comCode = \case
      CAnd -> "AND"
      COr  -> "OR"
      CNot -> "NOT"
  
  instrCode :: Instr -> Text
  instrCode (I c x y) = T.pack $ printf "%s %c %c" (comCode c) (regCode x) (regCode y)
  
  