module Nove.Logic where

import Nove.Verse

import Zero ( total, floyd )
import Data.IntMap as IntMap ( IntMap, (!), foldrWithKey, fromDistinctAscList )
import Data.Map as Map ( Map, fromList, filterWithKey, elems )
import Data.Bifunctor ( bimap )

data Memo a = Memo
   { mauto :: a
   , mdest :: [Int]
   , mfree :: Bool
   }

-- | Step in simulation

step :: forall a. Atom a => (Map Dir a -> a -> a) -> Verse a -> Verse a
step f v = v'
   where

   v' :: Verse a
   v' = v { nodes = nodes' }

   -- fold go with future memo
   (memo',nodes') = bimap intmap intmap $ IntMap.foldrWithKey go mempty $ nodes v
      where

      intmap :: [v] -> IntMap v
      intmap = IntMap.fromDistinctAscList . zip [0..]

   -- simulate atom and apply f
   go :: Int -> a -> ([Memo a], [a]) -> ([Memo a], [a])
   go i a (ms,as) = (m : ms , a' : as)
      where

      -- memoization for this node
      m :: Memo a
      m = Memo
         { mauto = w
         , mdest = dest
         , mfree = free
         }

      w :: a
      w = f (adjacents v i) a

      -- new atom
      a' :: a
         | free , [n] <- ins                        = n  -- move in
         | d : _ <- dest , mfree (memo' IntMap.! d) = void  -- move out
         | otherwise                                = w

      -- move in
      ins :: [a]
      ins = Map.elems $ Map.filterWithKey (\dir c -> move c == Just (opposite dir)) ns

      ns :: Map Dir a
      ns = Map.fromList $ (,) <*> (node v . flip (shift v 1) i) <$> total

      -- chain of destinations
      dest :: [Int]
         | Just dir <- move w , d <- shift v 1 dir i = d : mdest (memo' IntMap.! d)
         | otherwise = []

      -- is this node free?
      free :: Bool
         | lock w , null dest             = False
         | length ins > 1                 = False  -- stall
         | Just (_,d) <- floyd $ i : dest = False  -- i == d  -- floyd $ cycle [0,1] => Just (2,1) , so (i /= d) when reciprocal
         | otherwise                      = all (mfree . (memo' IntMap.!)) $ take 1 dest  -- dest is free

   -- come = catMaybes $ f <$> total
   --    where

   --    f dir
   --       | n <- node v $ shift v 1 dir i , Just d <- move n , dir == opposite d = Just n
   --       | otherwise = Nothing