haskell_furnace.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

data One
data Succ n

data IronOre
data Iron
data CopperOre
data Copper

data Stack n i
data EmptyStack
data Furnace input output time

type family Add n m where
  Add One m      = Succ m
  Add (Succ n) m = Succ (Add n m)

type family Insert stack furnace where
  Insert (Stack n i) (Furnace EmptyStack out t)    = Furnace (Stack n i) out t
  Insert (Stack n i) (Furnace (Stack n2 i) out t) = Furnace (Stack (Add n n2) i) out t

type family Tick f where
  -- Input is empty
  Tick (Furnace EmptyStack o t) = Furnace EmptyStack o (Succ t)

  -- Last item in input matches output material
  Tick (Furnace (Stack One i) (Stack n2 i) t) = Furnace EmptyStack (Stack (Succ n2) i) (Succ t)

  -- Multiple items in input match output material
  Tick (Furnace (Stack (Succ n) i) (Stack n2 i) t) = Furnace (Stack n i) (Stack (Succ n2) i) (Succ t)
  
  -- Fallback (output occupied by different type)
  Tick (Furnace i o t) = Furnace i o (Succ t)

type family PassTime d f where
  PassTime One f      = Tick f
  PassTime (Succ d) f = PassTime d (Tick f)