module Day5.Part1 (
  StackIndex (..),
  Operation (..),
  Stack (..),
  parseOperation,
  parseStacks,
  parseRow,
  combineRows,
  parseInput,
  executeOperation,
  zipWithPadding,
  findTopOfStacks,
  day5_1
) where

import qualified Data.Sequence as S
import Data.Sequence (Seq (..))
import Data.Foldable (toList)

newtype StackIndex = StackIndex Int deriving (Show, Eq, Ord)
asInt :: StackIndex -> Int
asInt (StackIndex i) = i - 1

data Operation = Operation
                    { count :: Int
                    , from :: StackIndex
                    , to :: StackIndex} deriving (Show, Eq)

type Content = Char
newtype Stack = Stack [Content] deriving (Show, Eq)

content :: Stack  -> [Content]
content (Stack c) = c

instance Semigroup Stack where
  (Stack x) <> (Stack y) = Stack (x ++ y)

instance Monoid Stack where
  mempty = Stack []

type Row = S.Seq Stack

parseOperation :: String -> Operation
parseOperation line = Operation {
 count = read $ parts !! 1,
  from = StackIndex (read $ parts !! 3),
  to = StackIndex (read $ parts !! 5)
  }
  where
    parts = words line

parseStacks :: [String] -> Row
parseStacks input = foldl combineRows S.empty rows
  where
    rows = map parseRow input

parseRow :: String -> Row
parseRow ('[':c:']':' ':cs) = Stack [c] :<| parseRow cs
parseRow (' ':' ':' ':' ':cs) = Stack [] :<| parseRow cs
parseRow ['[', c, ']'] = S.singleton $ Stack [c]
parseRow [' ', ' ', ' '] = S.singleton $ Stack []
parseRow (' ':'1':_) = S.empty -- skip last line
parseRow cs = error ("parseRow: unexpected Row \"" ++ cs ++ "\"")

combineRows :: Row -> Row -> Row
combineRows S.Empty row = row
combineRows row S.Empty = row
combineRows up down = S.fromList [x <> y | (x,y) <- zipWithPadding up down]

zipWithPadding :: (Monoid a, Monoid b) => S.Seq a -> S.Seq b -> [(a,b)]
zipWithPadding (x :<| xs)  (y :<| ys)  = (x,y) : zipWithPadding xs ys
zipWithPadding S.Empty (y :<| ys)  = (mempty, y) : zipWithPadding S.empty ys
zipWithPadding (x :<| xs)  S.Empty = (x, mempty) : zipWithPadding xs S.empty
zipWithPadding S.Empty  S.Empty = []

parseInput :: String -> (Row, [Operation])
parseInput input = (parseStacks stackInput, map parseOperation (drop 1 operationInput))
  where
    (stackInput, operationInput) = break ("" ==) $ lines input

executeOperation :: Row -> Operation -> Row
executeOperation row op
  | count op == 1 = updatedRow
  | otherwise = executeOperation updatedRow (Operation { count = count op - 1, from = from op, to = to op })
  where
    originStack = row `S.index` asInt (from op)
    targetStack = row `S.index` asInt (to op)
    movedContent = head $ content originStack
    updatedOrigin = Stack (drop 1 $ content originStack)
    updatedTarget = Stack (movedContent : content targetStack)
    updatedRow = S.update (asInt $ to op) updatedTarget $ S.update (asInt $ from op) updatedOrigin row

findTopOfStacks :: Row -> Seq Content
findTopOfStacks row = head . content <$> row

executeAllOperations :: Row -> [Operation] -> Row
executeAllOperations = foldl executeOperation

day5_1 :: String -> String
day5_1 input = toList . findTopOfStacks $ executeAllOperations row operations
  where
    (row, operations) = parseInput input