-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Online operations for structure recognizer.
--
-- See "Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute" for
-- details of the structure recognition process.
module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking (
  RecognitionActiveStatus (..),
  entityModified,
  entityModifiedLoggable,
) where

import Control.Arrow (left, (&&&))
import Control.Lens ((%~), (&), (.~), (^.))
import Control.Monad (foldM, forM_, guard, unless)
import Control.Monad.Extra (findM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Control.Monad.Trans.Writer.Strict
import Data.Either (partitionEithers)
import Data.Either.Extra (maybeToEither)
import Data.Function (on)
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.Hashable (Hashable)
import Data.IntSet qualified as IS
import Data.IntSet.NonEmpty (NEIntSet)
import Data.IntSet.NonEmpty qualified as NEIS
import Data.List (sortOn)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Ord (Down (..))
import Data.Semigroup (Max (..), Min (..))
import Data.Tuple (swap)
import Linear (V2 (..))
import Swarm.Game.Location (Location)
import Swarm.Game.Scenario.Topography.Structure.Named (name)
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (GenericEntLocator, ensureStructureIntact)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (binTuplesHM)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.Scenario.Topography.Terraform
import Swarm.Game.Universe
import Text.AhoCorasick

data RecognitionActiveStatus
  = RecognizeNewStructures
  | -- | Do not add new recognitions to the registry.
    -- This is useful if one needs to construct a larger structure
    -- for which other smaller structures contained within it
    -- would otherwise be recognized first, precluding the larger
    -- structure from ever being recognized.
    -- Removing elements of a previously recognized structure
    -- will still cause it to be removed from the registry.
    DisableNewRecognition
  deriving (Int -> RecognitionActiveStatus -> ShowS
[RecognitionActiveStatus] -> ShowS
RecognitionActiveStatus -> String
(Int -> RecognitionActiveStatus -> ShowS)
-> (RecognitionActiveStatus -> String)
-> ([RecognitionActiveStatus] -> ShowS)
-> Show RecognitionActiveStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecognitionActiveStatus -> ShowS
showsPrec :: Int -> RecognitionActiveStatus -> ShowS
$cshow :: RecognitionActiveStatus -> String
show :: RecognitionActiveStatus -> String
$cshowList :: [RecognitionActiveStatus] -> ShowS
showList :: [RecognitionActiveStatus] -> ShowS
Show, RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
(RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> (RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> Eq RecognitionActiveStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
== :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
$c/= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
/= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
Eq, Eq RecognitionActiveStatus
Eq RecognitionActiveStatus =>
(RecognitionActiveStatus -> RecognitionActiveStatus -> Ordering)
-> (RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> (RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> (RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> (RecognitionActiveStatus -> RecognitionActiveStatus -> Bool)
-> (RecognitionActiveStatus
    -> RecognitionActiveStatus -> RecognitionActiveStatus)
-> (RecognitionActiveStatus
    -> RecognitionActiveStatus -> RecognitionActiveStatus)
-> Ord RecognitionActiveStatus
RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
RecognitionActiveStatus -> RecognitionActiveStatus -> Ordering
RecognitionActiveStatus
-> RecognitionActiveStatus -> RecognitionActiveStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RecognitionActiveStatus -> RecognitionActiveStatus -> Ordering
compare :: RecognitionActiveStatus -> RecognitionActiveStatus -> Ordering
$c< :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
< :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
$c<= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
<= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
$c> :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
> :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
$c>= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
>= :: RecognitionActiveStatus -> RecognitionActiveStatus -> Bool
$cmax :: RecognitionActiveStatus
-> RecognitionActiveStatus -> RecognitionActiveStatus
max :: RecognitionActiveStatus
-> RecognitionActiveStatus -> RecognitionActiveStatus
$cmin :: RecognitionActiveStatus
-> RecognitionActiveStatus -> RecognitionActiveStatus
min :: RecognitionActiveStatus
-> RecognitionActiveStatus -> RecognitionActiveStatus
Ord, Int -> RecognitionActiveStatus
RecognitionActiveStatus -> Int
RecognitionActiveStatus -> [RecognitionActiveStatus]
RecognitionActiveStatus -> RecognitionActiveStatus
RecognitionActiveStatus
-> RecognitionActiveStatus -> [RecognitionActiveStatus]
RecognitionActiveStatus
-> RecognitionActiveStatus
-> RecognitionActiveStatus
-> [RecognitionActiveStatus]
(RecognitionActiveStatus -> RecognitionActiveStatus)
-> (RecognitionActiveStatus -> RecognitionActiveStatus)
-> (Int -> RecognitionActiveStatus)
-> (RecognitionActiveStatus -> Int)
-> (RecognitionActiveStatus -> [RecognitionActiveStatus])
-> (RecognitionActiveStatus
    -> RecognitionActiveStatus -> [RecognitionActiveStatus])
-> (RecognitionActiveStatus
    -> RecognitionActiveStatus -> [RecognitionActiveStatus])
-> (RecognitionActiveStatus
    -> RecognitionActiveStatus
    -> RecognitionActiveStatus
    -> [RecognitionActiveStatus])
-> Enum RecognitionActiveStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RecognitionActiveStatus -> RecognitionActiveStatus
succ :: RecognitionActiveStatus -> RecognitionActiveStatus
$cpred :: RecognitionActiveStatus -> RecognitionActiveStatus
pred :: RecognitionActiveStatus -> RecognitionActiveStatus
$ctoEnum :: Int -> RecognitionActiveStatus
toEnum :: Int -> RecognitionActiveStatus
$cfromEnum :: RecognitionActiveStatus -> Int
fromEnum :: RecognitionActiveStatus -> Int
$cenumFrom :: RecognitionActiveStatus -> [RecognitionActiveStatus]
enumFrom :: RecognitionActiveStatus -> [RecognitionActiveStatus]
$cenumFromThen :: RecognitionActiveStatus
-> RecognitionActiveStatus -> [RecognitionActiveStatus]
enumFromThen :: RecognitionActiveStatus
-> RecognitionActiveStatus -> [RecognitionActiveStatus]
$cenumFromTo :: RecognitionActiveStatus
-> RecognitionActiveStatus -> [RecognitionActiveStatus]
enumFromTo :: RecognitionActiveStatus
-> RecognitionActiveStatus -> [RecognitionActiveStatus]
$cenumFromThenTo :: RecognitionActiveStatus
-> RecognitionActiveStatus
-> RecognitionActiveStatus
-> [RecognitionActiveStatus]
enumFromThenTo :: RecognitionActiveStatus
-> RecognitionActiveStatus
-> RecognitionActiveStatus
-> [RecognitionActiveStatus]
Enum, RecognitionActiveStatus
RecognitionActiveStatus
-> RecognitionActiveStatus -> Bounded RecognitionActiveStatus
forall a. a -> a -> Bounded a
$cminBound :: RecognitionActiveStatus
minBound :: RecognitionActiveStatus
$cmaxBound :: RecognitionActiveStatus
maxBound :: RecognitionActiveStatus
Bounded)

-- | A hook called from the centralized entity update function,
-- 'Swarm.Game.Step.Util.updateEntityAt'.
entityModified ::
  (Monad s, Hashable a, Eq b) =>
  GenericEntLocator s a ->
  CellModification a ->
  Cosmic Location ->
  RecognizerAutomatons b a ->
  RecognitionState b a ->
  s (RecognitionState b a)
entityModified :: forall (s :: * -> *) a b.
(Monad s, Hashable a, Eq b) =>
GenericEntLocator s a
-> CellModification a
-> Cosmic Location
-> RecognizerAutomatons b a
-> RecognitionState b a
-> s (RecognitionState b a)
entityModified GenericEntLocator s a
entLoader CellModification a
modification Cosmic Location
cLoc RecognizerAutomatons b a
autoRecognizer RecognitionState b a
oldRecognitionState = do
  (RecognitionState b a
val, [SearchLog a]
accumulatedLogs) <-
    WriterT [SearchLog a] s (RecognitionState b a)
-> s (RecognitionState b a, [SearchLog a])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [SearchLog a] s (RecognitionState b a)
 -> s (RecognitionState b a, [SearchLog a]))
-> WriterT [SearchLog a] s (RecognitionState b a)
-> s (RecognitionState b a, [SearchLog a])
forall a b. (a -> b) -> a -> b
$
      RecognitionActiveStatus
-> GenericEntLocator s a
-> CellModification a
-> Cosmic Location
-> RecognizerAutomatons b a
-> RecognitionState b a
-> WriterT [SearchLog a] s (RecognitionState b a)
forall (f :: * -> *) a (m :: * -> *) b.
(Monoid (f (SearchLog a)), Monad m, Hashable a, Eq b,
 Applicative f) =>
RecognitionActiveStatus
-> (Cosmic Location -> m (AtomicKeySymbol a))
-> CellModification a
-> Cosmic Location
-> RecognizerAutomatons b a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
entityModifiedLoggable RecognitionActiveStatus
RecognizeNewStructures GenericEntLocator s a
entLoader CellModification a
modification Cosmic Location
cLoc RecognizerAutomatons b a
autoRecognizer RecognitionState b a
oldRecognitionState
  RecognitionState b a -> s (RecognitionState b a)
forall a. a -> s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecognitionState b a -> s (RecognitionState b a))
-> RecognitionState b a -> s (RecognitionState b a)
forall a b. (a -> b) -> a -> b
$
    RecognitionState b a
val
      RecognitionState b a
-> (RecognitionState b a -> RecognitionState b a)
-> RecognitionState b a
forall a b. a -> (a -> b) -> b
& ([SearchLog a] -> Identity [SearchLog a])
-> RecognitionState b a -> Identity (RecognitionState b a)
forall b a (f :: * -> *).
Functor f =>
([SearchLog a] -> f [SearchLog a])
-> RecognitionState b a -> f (RecognitionState b a)
recognitionLog (([SearchLog a] -> Identity [SearchLog a])
 -> RecognitionState b a -> Identity (RecognitionState b a))
-> ([SearchLog a] -> [SearchLog a])
-> RecognitionState b a
-> RecognitionState b a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([SearchLog a] -> [SearchLog a]
forall a. [a] -> [a]
reverse [SearchLog a]
accumulatedLogs [SearchLog a] -> [SearchLog a] -> [SearchLog a]
forall a. Semigroup a => a -> a -> a
<>)

-- | This handles structure detection upon addition of an entity,
-- and structure de-registration upon removal of an entity.
-- Also handles atomic entity swaps.
entityModifiedLoggable ::
  (Monoid (f (SearchLog a)), Monad m, Hashable a, Eq b, Applicative f) =>
  RecognitionActiveStatus ->
  (Cosmic Location -> m (AtomicKeySymbol a)) ->
  CellModification a ->
  Cosmic Location ->
  RecognizerAutomatons b a ->
  RecognitionState b a ->
  WriterT (f (SearchLog a)) m (RecognitionState b a)
entityModifiedLoggable :: forall (f :: * -> *) a (m :: * -> *) b.
(Monoid (f (SearchLog a)), Monad m, Hashable a, Eq b,
 Applicative f) =>
RecognitionActiveStatus
-> (Cosmic Location -> m (AtomicKeySymbol a))
-> CellModification a
-> Cosmic Location
-> RecognizerAutomatons b a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
entityModifiedLoggable RecognitionActiveStatus
activeStatus Cosmic Location -> m (AtomicKeySymbol a)
entLoader CellModification a
modification Cosmic Location
cLoc RecognizerAutomatons b a
autoRecognizer RecognitionState b a
oldRecognitionState = do
  case CellModification a
modification of
    Add a
newEntity -> a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall {f :: * -> *}.
(Monoid (f (SearchLog a)), Applicative f) =>
a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
doAddition a
newEntity RecognitionState b a
oldRecognitionState
    Remove a
_ -> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall {f :: * -> *} {e} {m :: * -> *} {b2} {a}.
(Monoid (f (SearchLog e)), Monad m, Applicative f) =>
RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
doRemoval RecognitionState b a
oldRecognitionState
    Swap a
_ a
newEntity -> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall {f :: * -> *} {e} {m :: * -> *} {b2} {a}.
(Monoid (f (SearchLog e)), Monad m, Applicative f) =>
RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
doRemoval RecognitionState b a
oldRecognitionState WriterT (f (SearchLog a)) m (RecognitionState b a)
-> (RecognitionState b a
    -> WriterT (f (SearchLog a)) m (RecognitionState b a))
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall a b.
WriterT (f (SearchLog a)) m a
-> (a -> WriterT (f (SearchLog a)) m b)
-> WriterT (f (SearchLog a)) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall {f :: * -> *}.
(Monoid (f (SearchLog a)), Applicative f) =>
a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
doAddition a
newEntity
 where
  entLookup :: HashMap a (AutomatonInfo b a)
entLookup = RecognizerAutomatons b a
autoRecognizer RecognizerAutomatons b a
-> Getting
     (HashMap a (AutomatonInfo b a))
     (RecognizerAutomatons b a)
     (HashMap a (AutomatonInfo b a))
-> HashMap a (AutomatonInfo b a)
forall s a. s -> Getting a s a -> a
^. Getting
  (HashMap a (AutomatonInfo b a))
  (RecognizerAutomatons b a)
  (HashMap a (AutomatonInfo b a))
forall b a (f :: * -> *).
Functor f =>
(HashMap a (AutomatonInfo b a)
 -> f (HashMap a (AutomatonInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
automatonsByEntity

  doAddition :: a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
doAddition a
newEntity = case RecognitionActiveStatus
activeStatus of
    RecognitionActiveStatus
RecognizeNewStructures -> (RecognitionState b a
 -> WriterT (f (SearchLog a)) m (RecognitionState b a))
-> (AutomatonInfo b a
    -> RecognitionState b a
    -> WriterT (f (SearchLog a)) m (RecognitionState b a))
-> Maybe (AutomatonInfo b a)
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall a. a -> WriterT (f (SearchLog a)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return AutomatonInfo b a
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall {f :: * -> *} {b2}.
(Monoid (f (SearchLog a)), Eq b2, Applicative f) =>
AutomatonInfo b2 a
-> RecognitionState b2 a
-> WriterT (f (SearchLog a)) m (RecognitionState b2 a)
logAndRegister (Maybe (AutomatonInfo b a)
 -> RecognitionState b a
 -> WriterT (f (SearchLog a)) m (RecognitionState b a))
-> Maybe (AutomatonInfo b a)
-> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall a b. (a -> b) -> a -> b
$ a -> HashMap a (AutomatonInfo b a) -> Maybe (AutomatonInfo b a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup a
newEntity HashMap a (AutomatonInfo b a)
entLookup
    RecognitionActiveStatus
DisableNewRecognition -> RecognitionState b a
-> WriterT (f (SearchLog a)) m (RecognitionState b a)
forall a. a -> WriterT (f (SearchLog a)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return
   where
    logAndRegister :: AutomatonInfo b2 a
-> RecognitionState b2 a
-> WriterT (f (SearchLog a)) m (RecognitionState b2 a)
logAndRegister AutomatonInfo b2 a
finder RecognitionState b2 a
s = do
      f (SearchLog a) -> WriterT (f (SearchLog a)) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) m ())
-> (ParticipatingEntity a -> f (SearchLog a))
-> ParticipatingEntity a
-> WriterT (f (SearchLog a)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> (ParticipatingEntity a -> SearchLog a)
-> ParticipatingEntity a
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParticipatingEntity a -> SearchLog a
forall e. ParticipatingEntity e -> SearchLog e
FoundParticipatingEntity (ParticipatingEntity a -> WriterT (f (SearchLog a)) m ())
-> ParticipatingEntity a -> WriterT (f (SearchLog a)) m ()
forall a b. (a -> b) -> a -> b
$
        a -> InspectionOffsets -> ParticipatingEntity a
forall e. e -> InspectionOffsets -> ParticipatingEntity e
ParticipatingEntity
          a
newEntity
          (AutomatonInfo b2 a
finder AutomatonInfo b2 a
-> Getting InspectionOffsets (AutomatonInfo b2 a) InspectionOffsets
-> InspectionOffsets
forall s a. s -> Getting a s a -> a
^. Getting InspectionOffsets (AutomatonInfo b2 a) InspectionOffsets
forall v k (f :: * -> *).
Functor f =>
(InspectionOffsets -> f InspectionOffsets)
-> AutomatonInfo v k -> f (AutomatonInfo v k)
inspectionOffsets)
      FoundRegistry b2 a
newFoundStructures <- (Cosmic Location -> m (AtomicKeySymbol a))
-> Cosmic Location
-> AutomatonInfo b2 a
-> FoundRegistry b2 a
-> WriterT (f (SearchLog a)) m (FoundRegistry b2 a)
forall (f :: * -> *) a (s :: * -> *) b.
(Monoid (f (SearchLog a)), Applicative f, Monad s, Hashable a,
 Eq b) =>
GenericEntLocator s a
-> Cosmic Location
-> AutomatonInfo b a
-> FoundRegistry b a
-> WriterT (f (SearchLog a)) s (FoundRegistry b a)
registerRowMatches Cosmic Location -> m (AtomicKeySymbol a)
entLoader Cosmic Location
cLoc AutomatonInfo b2 a
finder (FoundRegistry b2 a
 -> WriterT (f (SearchLog a)) m (FoundRegistry b2 a))
-> FoundRegistry b2 a
-> WriterT (f (SearchLog a)) m (FoundRegistry b2 a)
forall a b. (a -> b) -> a -> b
$ RecognitionState b2 a
s RecognitionState b2 a
-> Getting
     (FoundRegistry b2 a) (RecognitionState b2 a) (FoundRegistry b2 a)
-> FoundRegistry b2 a
forall s a. s -> Getting a s a -> a
^. Getting
  (FoundRegistry b2 a) (RecognitionState b2 a) (FoundRegistry b2 a)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures
      RecognitionState b2 a
-> WriterT (f (SearchLog a)) m (RecognitionState b2 a)
forall a. a -> WriterT (f (SearchLog a)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecognitionState b2 a
 -> WriterT (f (SearchLog a)) m (RecognitionState b2 a))
-> RecognitionState b2 a
-> WriterT (f (SearchLog a)) m (RecognitionState b2 a)
forall a b. (a -> b) -> a -> b
$ RecognitionState b2 a
s RecognitionState b2 a
-> (RecognitionState b2 a -> RecognitionState b2 a)
-> RecognitionState b2 a
forall a b. a -> (a -> b) -> b
& (FoundRegistry b2 a -> Identity (FoundRegistry b2 a))
-> RecognitionState b2 a -> Identity (RecognitionState b2 a)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures ((FoundRegistry b2 a -> Identity (FoundRegistry b2 a))
 -> RecognitionState b2 a -> Identity (RecognitionState b2 a))
-> FoundRegistry b2 a
-> RecognitionState b2 a
-> RecognitionState b2 a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FoundRegistry b2 a
newFoundStructures

  doRemoval :: RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
doRemoval RecognitionState b2 a
sOld =
    -- Entity was removed; may need to remove registered structure.
    (RecognitionState b2 a
 -> WriterT (f (SearchLog e)) m (RecognitionState b2 a))
-> (PositionedStructure (StructureWithGrid b2 a)
    -> RecognitionState b2 a
    -> WriterT (f (SearchLog e)) m (RecognitionState b2 a))
-> Maybe (PositionedStructure (StructureWithGrid b2 a))
-> RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
forall a. a -> WriterT (f (SearchLog e)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return PositionedStructure (StructureWithGrid b2 a)
-> RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
forall {f :: * -> *} {e} {m :: * -> *} {b2} {a}.
(Monoid (f (SearchLog e)), Monad m, Applicative f) =>
PositionedStructure (StructureWithGrid b2 a)
-> RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
logAndRemove Maybe (PositionedStructure (StructureWithGrid b2 a))
structureAtLoc RecognitionState b2 a
sOld
   where
    structureAtLoc :: Maybe (PositionedStructure (StructureWithGrid b2 a))
structureAtLoc = Cosmic Location
-> Map
     (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a))
-> Maybe (PositionedStructure (StructureWithGrid b2 a))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Cosmic Location
cLoc (Map
   (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a))
 -> Maybe (PositionedStructure (StructureWithGrid b2 a)))
-> Map
     (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a))
-> Maybe (PositionedStructure (StructureWithGrid b2 a))
forall a b. (a -> b) -> a -> b
$ FoundRegistry b2 a
-> Map
     (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a))
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation (FoundRegistry b2 a
 -> Map
      (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a)))
-> FoundRegistry b2 a
-> Map
     (Cosmic Location) (PositionedStructure (StructureWithGrid b2 a))
forall a b. (a -> b) -> a -> b
$ RecognitionState b2 a
sOld RecognitionState b2 a
-> Getting
     (FoundRegistry b2 a) (RecognitionState b2 a) (FoundRegistry b2 a)
-> FoundRegistry b2 a
forall s a. s -> Getting a s a -> a
^. Getting
  (FoundRegistry b2 a) (RecognitionState b2 a) (FoundRegistry b2 a)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures
    logAndRemove :: PositionedStructure (StructureWithGrid b2 a)
-> RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
logAndRemove PositionedStructure (StructureWithGrid b2 a)
fs RecognitionState b2 a
s = do
      f (SearchLog e) -> WriterT (f (SearchLog e)) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog e) -> WriterT (f (SearchLog e)) m ())
-> f (SearchLog e) -> WriterT (f (SearchLog e)) m ()
forall a b. (a -> b) -> a -> b
$ SearchLog e -> f (SearchLog e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog e -> f (SearchLog e)) -> SearchLog e -> f (SearchLog e)
forall a b. (a -> b) -> a -> b
$ StructureName -> SearchLog e
forall e. StructureName -> SearchLog e
StructureRemoved StructureName
structureName
      RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
forall a. a -> WriterT (f (SearchLog e)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecognitionState b2 a
 -> WriterT (f (SearchLog e)) m (RecognitionState b2 a))
-> RecognitionState b2 a
-> WriterT (f (SearchLog e)) m (RecognitionState b2 a)
forall a b. (a -> b) -> a -> b
$ RecognitionState b2 a
s RecognitionState b2 a
-> (RecognitionState b2 a -> RecognitionState b2 a)
-> RecognitionState b2 a
forall a b. a -> (a -> b) -> b
& (FoundRegistry b2 a -> Identity (FoundRegistry b2 a))
-> RecognitionState b2 a -> Identity (RecognitionState b2 a)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures ((FoundRegistry b2 a -> Identity (FoundRegistry b2 a))
 -> RecognitionState b2 a -> Identity (RecognitionState b2 a))
-> (FoundRegistry b2 a -> FoundRegistry b2 a)
-> RecognitionState b2 a
-> RecognitionState b2 a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PositionedStructure (StructureWithGrid b2 a)
-> FoundRegistry b2 a -> FoundRegistry b2 a
forall b a.
FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a
removeStructure PositionedStructure (StructureWithGrid b2 a)
fs
     where
      structureName :: StructureName
structureName = NamedArea b2 -> StructureName
forall a. NamedArea a -> StructureName
name (NamedArea b2 -> StructureName)
-> (StructureWithGrid b2 a -> NamedArea b2)
-> StructureWithGrid b2 a
-> StructureName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtractedArea b2 a -> NamedArea b2
forall b a. ExtractedArea b a -> NamedArea b
originalItem (ExtractedArea b2 a -> NamedArea b2)
-> (StructureWithGrid b2 a -> ExtractedArea b2 a)
-> StructureWithGrid b2 a
-> NamedArea b2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureWithGrid b2 a -> ExtractedArea b2 a
forall b a. StructureWithGrid b a -> ExtractedArea b a
entityGrid (StructureWithGrid b2 a -> StructureName)
-> StructureWithGrid b2 a -> StructureName
forall a b. (a -> b) -> a -> b
$ PositionedStructure (StructureWithGrid b2 a)
-> StructureWithGrid b2 a
forall s. PositionedStructure s -> s
structureWithGrid PositionedStructure (StructureWithGrid b2 a)
fs

-- | In case this cell would match a candidate structure,
-- ensures that the entity in this cell is not already
-- participating in a registered structure.
--
-- Furthermore, treating cells in registered structures
-- as 'Nothing' has the effect of "masking" them out,
-- so that they can overlap empty cells within the bounding
-- box of the candidate structure.
candidateEntityAt ::
  (Monad s, Hashable a) =>
  GenericEntLocator s a ->
  FoundRegistry b a ->
  Cosmic Location ->
  s (AtomicKeySymbol a)
candidateEntityAt :: forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
GenericEntLocator s a -> FoundRegistry b a -> GenericEntLocator s a
candidateEntityAt GenericEntLocator s a
entLoader FoundRegistry b a
registry Cosmic Location
cLoc = MaybeT s a -> s (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT s a -> s (Maybe a)) -> MaybeT s a -> s (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  Bool -> MaybeT s ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT s ()) -> Bool -> MaybeT s ()
forall a b. (a -> b) -> a -> b
$ Cosmic Location
-> Map (Cosmic Location) (FoundStructure b a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.notMember Cosmic Location
cLoc (Map (Cosmic Location) (FoundStructure b a) -> Bool)
-> Map (Cosmic Location) (FoundStructure b a) -> Bool
forall a b. (a -> b) -> a -> b
$ FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
forall b a.
FoundRegistry b a -> Map (Cosmic Location) (FoundStructure b a)
foundByLocation FoundRegistry b a
registry
  s (Maybe a) -> MaybeT s a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (s (Maybe a) -> MaybeT s a) -> s (Maybe a) -> MaybeT s a
forall a b. (a -> b) -> a -> b
$ GenericEntLocator s a
entLoader Cosmic Location
cLoc

-- | Excludes entities that are already part of a
-- registered found structure.
getWorldRow ::
  (Monad s, Hashable a) =>
  GenericEntLocator s a ->
  FoundRegistry b a ->
  Cosmic Location ->
  InspectionOffsets ->
  s [AtomicKeySymbol a]
getWorldRow :: forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
GenericEntLocator s a
-> FoundRegistry b a
-> Cosmic Location
-> InspectionOffsets
-> s [AtomicKeySymbol a]
getWorldRow GenericEntLocator s a
entLoader FoundRegistry b a
registry Cosmic Location
cLoc (InspectionOffsets (Min Int32
offsetLeft) (Max Int32
offsetRight)) = do
  GenericEntLocator s a -> [Cosmic Location] -> s [AtomicKeySymbol a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenericEntLocator s a
getCandidate [Cosmic Location]
horizontalOffsets
 where
  getCandidate :: GenericEntLocator s a
getCandidate = GenericEntLocator s a -> FoundRegistry b a -> GenericEntLocator s a
forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
GenericEntLocator s a -> FoundRegistry b a -> GenericEntLocator s a
candidateEntityAt GenericEntLocator s a
entLoader FoundRegistry b a
registry
  horizontalOffsets :: [Cosmic Location]
horizontalOffsets = (Int32 -> Cosmic Location) -> [Int32] -> [Cosmic Location]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Cosmic Location
mkLoc [Int32
offsetLeft .. Int32
offsetRight]
  mkLoc :: Int32 -> Cosmic Location
mkLoc Int32
x = Cosmic Location
cLoc Cosmic Location -> V2 Int32 -> Cosmic Location
`offsetBy` Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
x Int32
0

-- | This runs once per non-overlapping subset of found chunks
checkChunksCombination ::
  (Monoid (f (SearchLog a)), Applicative f, Monad m, Hashable a, Eq b) =>
  Cosmic Location ->
  InspectionOffsets ->
  NE.NonEmpty (RowChunkMatchingReference b a) ->
  [Position (NE.NonEmpty a)] ->
  WriterT (f (SearchLog a)) m [FoundStructure b a]
checkChunksCombination :: forall (f :: * -> *) a (m :: * -> *) b.
(Monoid (f (SearchLog a)), Applicative f, Monad m, Hashable a,
 Eq b) =>
Cosmic Location
-> InspectionOffsets
-> NonEmpty (RowChunkMatchingReference b a)
-> [Position (NonEmpty a)]
-> WriterT (f (SearchLog a)) m [FoundStructure b a]
checkChunksCombination
  Cosmic Location
cLoc
  InspectionOffsets
horizontalOffsets
  NonEmpty (RowChunkMatchingReference b a)
rowChunkReferences
  [Position (NonEmpty a)]
candidatesChunked = do
    f (SearchLog a) -> WriterT (f (SearchLog a)) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) m ())
-> (HashMap (NonEmpty a) (NonEmpty Int) -> f (SearchLog a))
-> HashMap (NonEmpty a) (NonEmpty Int)
-> WriterT (f (SearchLog a)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> (HashMap (NonEmpty a) (NonEmpty Int) -> SearchLog a)
-> HashMap (NonEmpty a) (NonEmpty Int)
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(NonEmpty Int, NonEmpty a)] -> SearchLog a
forall e. [(NonEmpty Int, NonEmpty e)] -> SearchLog e
FoundPiecewiseChunks ([(NonEmpty Int, NonEmpty a)] -> SearchLog a)
-> (HashMap (NonEmpty a) (NonEmpty Int)
    -> [(NonEmpty Int, NonEmpty a)])
-> HashMap (NonEmpty a) (NonEmpty Int)
-> SearchLog a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NonEmpty a, NonEmpty Int) -> (NonEmpty Int, NonEmpty a))
-> [(NonEmpty a, NonEmpty Int)] -> [(NonEmpty Int, NonEmpty a)]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty a, NonEmpty Int) -> (NonEmpty Int, NonEmpty a)
forall a b. (a, b) -> (b, a)
swap ([(NonEmpty a, NonEmpty Int)] -> [(NonEmpty Int, NonEmpty a)])
-> (HashMap (NonEmpty a) (NonEmpty Int)
    -> [(NonEmpty a, NonEmpty Int)])
-> HashMap (NonEmpty a) (NonEmpty Int)
-> [(NonEmpty Int, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (NonEmpty a) (NonEmpty Int) -> [(NonEmpty a, NonEmpty Int)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap (NonEmpty a) (NonEmpty Int)
 -> WriterT (f (SearchLog a)) m ())
-> HashMap (NonEmpty a) (NonEmpty Int)
-> WriterT (f (SearchLog a)) m ()
forall a b. (a -> b) -> a -> b
$
      (NEIntSet -> NonEmpty Int)
-> HashMap (NonEmpty a) NEIntSet
-> HashMap (NonEmpty a) (NonEmpty Int)
forall a b.
(a -> b) -> HashMap (NonEmpty a) a -> HashMap (NonEmpty a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NEIntSet -> NonEmpty Int
NEIS.elems HashMap (NonEmpty a) NEIntSet
foundRowChunksLookup

    f (SearchLog a) -> WriterT (f (SearchLog a)) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) m ())
-> ([ChunkMatchFailureReason a] -> f (SearchLog a))
-> [ChunkMatchFailureReason a]
-> WriterT (f (SearchLog a)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> ([ChunkMatchFailureReason a] -> SearchLog a)
-> [ChunkMatchFailureReason a]
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChunkMatchFailureReason a] -> SearchLog a
forall e. [ChunkMatchFailureReason e] -> SearchLog e
ChunkFailures ([ChunkMatchFailureReason a] -> WriterT (f (SearchLog a)) m ())
-> [ChunkMatchFailureReason a] -> WriterT (f (SearchLog a)) m ()
forall a b. (a -> b) -> a -> b
$ [ChunkMatchFailureReason a]
candidateFailures

    f (SearchLog a) -> WriterT (f (SearchLog a)) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) m ())
-> ([ChunkedRowMatch (NonEmpty StructureName) a]
    -> f (SearchLog a))
-> [ChunkedRowMatch (NonEmpty StructureName) a]
-> WriterT (f (SearchLog a)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> ([ChunkedRowMatch (NonEmpty StructureName) a] -> SearchLog a)
-> [ChunkedRowMatch (NonEmpty StructureName) a]
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChunkedRowMatch (NonEmpty StructureName) a] -> SearchLog a
forall e.
[ChunkedRowMatch (NonEmpty StructureName) e] -> SearchLog e
ChunksMatchingExpected ([ChunkedRowMatch (NonEmpty StructureName) a]
 -> WriterT (f (SearchLog a)) m ())
-> [ChunkedRowMatch (NonEmpty StructureName) a]
-> WriterT (f (SearchLog a)) m ()
forall a b. (a -> b) -> a -> b
$
      (ChunkedRowMatch (ConsolidatedRowReferences b a) a
 -> ChunkedRowMatch (NonEmpty StructureName) a)
-> [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
-> [ChunkedRowMatch (NonEmpty StructureName) a]
forall a b. (a -> b) -> [a] -> [b]
map ((FoundRowFromChunk (ConsolidatedRowReferences b a)
 -> FoundRowFromChunk (NonEmpty StructureName))
-> ChunkedRowMatch (ConsolidatedRowReferences b a) a
-> ChunkedRowMatch (NonEmpty StructureName) a
forall {a} {a} {e}.
(FoundRowFromChunk a -> FoundRowFromChunk a)
-> ChunkedRowMatch a e -> ChunkedRowMatch a e
modifyChunkedRowMatch ((FoundRowFromChunk (ConsolidatedRowReferences b a)
  -> FoundRowFromChunk (NonEmpty StructureName))
 -> ChunkedRowMatch (ConsolidatedRowReferences b a) a
 -> ChunkedRowMatch (NonEmpty StructureName) a)
-> (FoundRowFromChunk (ConsolidatedRowReferences b a)
    -> FoundRowFromChunk (NonEmpty StructureName))
-> ChunkedRowMatch (ConsolidatedRowReferences b a) a
-> ChunkedRowMatch (NonEmpty StructureName) a
forall a b. (a -> b) -> a -> b
$ (ConsolidatedRowReferences b a -> NonEmpty StructureName)
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
-> FoundRowFromChunk (NonEmpty StructureName)
forall a b. (a -> b) -> FoundRowFromChunk a -> FoundRowFromChunk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConsolidatedRowReferences b a -> NonEmpty StructureName
forall b a. ConsolidatedRowReferences b a -> NonEmpty StructureName
renderSharedNames) [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
candidateExpected

    [FoundStructure b a]
-> WriterT (f (SearchLog a)) m [FoundStructure b a]
forall a. a -> WriterT (f (SearchLog a)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [FoundStructure b a]
structurePositionsToCheck
   where
    structurePositionsToCheck :: [FoundStructure b a]
structurePositionsToCheck = (ChunkedRowMatch (ConsolidatedRowReferences b a) a
 -> [FoundStructure b a])
-> [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
-> [FoundStructure b a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ChunkedRowMatch (ConsolidatedRowReferences b a) a
-> [FoundStructure b a]
forall {b} {a} {e}.
ChunkedRowMatch (ConsolidatedRowReferences b a) e
-> [PositionedStructure (StructureWithGrid b a)]
mkFoundStructures [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
candidateExpected

    candidateExpected :: [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
candidateExpected = (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)
 -> [ChunkedRowMatch (ConsolidatedRowReferences b a) a])
-> [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)]
-> [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)
-> [ChunkedRowMatch (ConsolidatedRowReferences b a) a]
forall a. NonEmpty a -> [a]
NE.toList [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)]
candidateExpectedLists

    foundRowChunksLookup :: HashMap (NonEmpty a) NEIntSet
foundRowChunksLookup =
      (NonEmpty Int -> NEIntSet)
-> HashMap (NonEmpty a) (NonEmpty Int)
-> HashMap (NonEmpty a) NEIntSet
forall a b.
(a -> b) -> HashMap (NonEmpty a) a -> HashMap (NonEmpty a) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Int -> NEIntSet
NEIS.fromList (HashMap (NonEmpty a) (NonEmpty Int)
 -> HashMap (NonEmpty a) NEIntSet)
-> HashMap (NonEmpty a) (NonEmpty Int)
-> HashMap (NonEmpty a) NEIntSet
forall a b. (a -> b) -> a -> b
$
        [(NonEmpty a, Int)] -> HashMap (NonEmpty a) (NonEmpty Int)
forall (t :: * -> *) a b.
(Foldable t, Hashable a, Eq a) =>
t (a, b) -> HashMap a (NonEmpty b)
binTuplesHM ([(NonEmpty a, Int)] -> HashMap (NonEmpty a) (NonEmpty Int))
-> [(NonEmpty a, Int)] -> HashMap (NonEmpty a) (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$
          (Position (NonEmpty a) -> (NonEmpty a, Int))
-> [Position (NonEmpty a)] -> [(NonEmpty a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Position (NonEmpty a) -> NonEmpty a
forall val. Position val -> val
pVal (Position (NonEmpty a) -> NonEmpty a)
-> (Position (NonEmpty a) -> Int)
-> Position (NonEmpty a)
-> (NonEmpty a, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Position (NonEmpty a) -> Int
forall val. Position val -> Int
pIndex) [Position (NonEmpty a)]
candidatesChunked

    ([ChunkMatchFailureReason a]
candidateFailures, [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)]
candidateExpectedLists) =
      [Either
   (ChunkMatchFailureReason a)
   (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))]
-> ([ChunkMatchFailureReason a],
    [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either
    (ChunkMatchFailureReason a)
    (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))]
 -> ([ChunkMatchFailureReason a],
     [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)]))
-> [Either
      (ChunkMatchFailureReason a)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))]
-> ([ChunkMatchFailureReason a],
    [NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)])
forall a b. (a -> b) -> a -> b
$
        (RowChunkMatchingReference b a
 -> Either
      (ChunkMatchFailureReason a)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a)))
-> [RowChunkMatchingReference b a]
-> [Either
      (ChunkMatchFailureReason a)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))]
forall a b. (a -> b) -> [a] -> [b]
map (InspectionOffsets
-> HashMap (NonEmpty a) NEIntSet
-> RowChunkMatchingReference b a
-> Either
     (ChunkMatchFailureReason a)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))
forall e b.
Hashable e =>
InspectionOffsets
-> HashMap (NonEmpty e) NEIntSet
-> RowChunkMatchingReference b e
-> Either
     (ChunkMatchFailureReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
checkCandidateAgainstObservedChunks InspectionOffsets
horizontalOffsets HashMap (NonEmpty a) NEIntSet
foundRowChunksLookup) ([RowChunkMatchingReference b a]
 -> [Either
       (ChunkMatchFailureReason a)
       (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))])
-> [RowChunkMatchingReference b a]
-> [Either
      (ChunkMatchFailureReason a)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b a) a))]
forall a b. (a -> b) -> a -> b
$
          NonEmpty (RowChunkMatchingReference b a)
-> [RowChunkMatchingReference b a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (RowChunkMatchingReference b a)
rowChunkReferences

    mkFoundStructures :: ChunkedRowMatch (ConsolidatedRowReferences b a) e
-> [PositionedStructure (StructureWithGrid b a)]
mkFoundStructures ChunkedRowMatch (ConsolidatedRowReferences b a) e
x =
      NonEmpty (PositionedStructure (StructureWithGrid b a))
-> [PositionedStructure (StructureWithGrid b a)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (PositionedStructure (StructureWithGrid b a))
 -> [PositionedStructure (StructureWithGrid b a)])
-> NonEmpty (PositionedStructure (StructureWithGrid b a))
-> [PositionedStructure (StructureWithGrid b a)]
forall a b. (a -> b) -> a -> b
$ (StructureRow b a -> PositionedStructure (StructureWithGrid b a))
-> NonEmpty (StructureRow b a)
-> NonEmpty (PositionedStructure (StructureWithGrid b a))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map StructureRow b a -> PositionedStructure (StructureWithGrid b a)
forall {b} {a}.
StructureRow b a -> PositionedStructure (StructureWithGrid b a)
mkFoundStructure (NonEmpty (StructureRow b a)
 -> NonEmpty (PositionedStructure (StructureWithGrid b a)))
-> (FoundRowFromChunk (ConsolidatedRowReferences b a)
    -> NonEmpty (StructureRow b a))
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
-> NonEmpty (PositionedStructure (StructureWithGrid b a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsolidatedRowReferences b a -> NonEmpty (StructureRow b a)
forall b a.
ConsolidatedRowReferences b a -> NonEmpty (StructureRow b a)
referencingRows (ConsolidatedRowReferences b a -> NonEmpty (StructureRow b a))
-> (FoundRowFromChunk (ConsolidatedRowReferences b a)
    -> ConsolidatedRowReferences b a)
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
-> NonEmpty (StructureRow b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundRowFromChunk (ConsolidatedRowReferences b a)
-> ConsolidatedRowReferences b a
forall a. FoundRowFromChunk a -> a
chunkStructure (FoundRowFromChunk (ConsolidatedRowReferences b a)
 -> NonEmpty (PositionedStructure (StructureWithGrid b a)))
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
-> NonEmpty (PositionedStructure (StructureWithGrid b a))
forall a b. (a -> b) -> a -> b
$ ChunkedRowMatch (ConsolidatedRowReferences b a) e
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
forall a e. ChunkedRowMatch a e -> FoundRowFromChunk a
foundChunkRow ChunkedRowMatch (ConsolidatedRowReferences b a) e
x
     where
      mkFoundStructure :: StructureRow b a -> PositionedStructure (StructureWithGrid b a)
mkFoundStructure StructureRow b a
r =
        Cosmic Location
-> StructureWithGrid b a
-> PositionedStructure (StructureWithGrid b a)
forall s. Cosmic Location -> s -> PositionedStructure s
PositionedStructure
          (Cosmic Location
cLoc Cosmic Location -> V2 Int32 -> Cosmic Location
`offsetBy` V2 Int32
theOffset)
          (StructureRow b a -> StructureWithGrid b a
forall b a. StructureRow b a -> StructureWithGrid b a
wholeStructure StructureRow b a
r)
       where
        theOffset :: V2 Int32
theOffset = Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 (FoundRowFromChunk (ConsolidatedRowReferences b a) -> Int32
forall a. FoundRowFromChunk a -> Int32
horizontalStructPos (FoundRowFromChunk (ConsolidatedRowReferences b a) -> Int32)
-> FoundRowFromChunk (ConsolidatedRowReferences b a) -> Int32
forall a b. (a -> b) -> a -> b
$ ChunkedRowMatch (ConsolidatedRowReferences b a) e
-> FoundRowFromChunk (ConsolidatedRowReferences b a)
forall a e. ChunkedRowMatch a e -> FoundRowFromChunk a
foundChunkRow ChunkedRowMatch (ConsolidatedRowReferences b a) e
x) (StructureRow b a -> Int32
forall b a. StructureRow b a -> Int32
rowIndex StructureRow b a
r)

    modifyChunkedRowMatch :: (FoundRowFromChunk a -> FoundRowFromChunk a)
-> ChunkedRowMatch a e -> ChunkedRowMatch a e
modifyChunkedRowMatch FoundRowFromChunk a -> FoundRowFromChunk a
f (ChunkedRowMatch [(FoundAndExpectedChunkPositions, NonEmpty e)]
x FoundRowFromChunk a
y) = [(FoundAndExpectedChunkPositions, NonEmpty e)]
-> FoundRowFromChunk a -> ChunkedRowMatch a e
forall a e.
[(FoundAndExpectedChunkPositions, NonEmpty e)]
-> FoundRowFromChunk a -> ChunkedRowMatch a e
ChunkedRowMatch [(FoundAndExpectedChunkPositions, NonEmpty e)]
x (FoundRowFromChunk a -> FoundRowFromChunk a
f FoundRowFromChunk a
y)

checkCandidateAgainstObservedChunks ::
  Hashable e =>
  InspectionOffsets ->
  HM.HashMap (NE.NonEmpty e) NEIntSet ->
  RowChunkMatchingReference b e ->
  Either (ChunkMatchFailureReason e) (NE.NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
checkCandidateAgainstObservedChunks :: forall e b.
Hashable e =>
InspectionOffsets
-> HashMap (NonEmpty e) NEIntSet
-> RowChunkMatchingReference b e
-> Either
     (ChunkMatchFailureReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
checkCandidateAgainstObservedChunks InspectionOffsets
horizontalOffsets HashMap (NonEmpty e) NEIntSet
foundRowChunksLookup (RowChunkMatchingReference ConsolidatedRowReferences b e
r HashMap (NonEmpty e) (NonEmpty Int)
chunkPositionMap) =
  (RowMismatchReason e -> ChunkMatchFailureReason e)
-> Either
     (RowMismatchReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
-> Either
     (ChunkMatchFailureReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (NonEmpty StructureName
-> RowMismatchReason e -> ChunkMatchFailureReason e
forall e.
NonEmpty StructureName
-> RowMismatchReason e -> ChunkMatchFailureReason e
ChunkMatchFailureReason (NonEmpty StructureName
 -> RowMismatchReason e -> ChunkMatchFailureReason e)
-> NonEmpty StructureName
-> RowMismatchReason e
-> ChunkMatchFailureReason e
forall a b. (a -> b) -> a -> b
$ ConsolidatedRowReferences b e -> NonEmpty StructureName
forall b a. ConsolidatedRowReferences b a -> NonEmpty StructureName
renderSharedNames ConsolidatedRowReferences b e
r) (Either
   (RowMismatchReason e)
   (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
 -> Either
      (ChunkMatchFailureReason e)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)))
-> Either
     (RowMismatchReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
-> Either
     (ChunkMatchFailureReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
forall a b. (a -> b) -> a -> b
$ do
    Bool
-> Either (RowMismatchReason e) ()
-> Either (RowMismatchReason e) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isKeysSubset (Either (RowMismatchReason e) ()
 -> Either (RowMismatchReason e) ())
-> (RowMismatchReason e -> Either (RowMismatchReason e) ())
-> RowMismatchReason e
-> Either (RowMismatchReason e) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowMismatchReason e -> Either (RowMismatchReason e) ()
forall a b. a -> Either a b
Left (RowMismatchReason e -> Either (RowMismatchReason e) ())
-> RowMismatchReason e -> Either (RowMismatchReason e) ()
forall a b. (a -> b) -> a -> b
$
      FoundChunkComparison e -> RowMismatchReason e
forall e. FoundChunkComparison e -> RowMismatchReason e
NoKeysSubset (FoundChunkComparison e -> RowMismatchReason e)
-> FoundChunkComparison e -> RowMismatchReason e
forall a b. (a -> b) -> a -> b
$
        ([NonEmpty e] -> [NonEmpty e] -> FoundChunkComparison e
forall e. [NonEmpty e] -> [NonEmpty e] -> FoundChunkComparison e
FoundChunkComparison ([NonEmpty e] -> [NonEmpty e] -> FoundChunkComparison e)
-> (HashSet (NonEmpty e) -> [NonEmpty e])
-> HashSet (NonEmpty e)
-> HashSet (NonEmpty e)
-> FoundChunkComparison e
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` HashSet (NonEmpty e) -> [NonEmpty e]
forall a. HashSet a -> [a]
HS.toList) HashSet (NonEmpty e)
foundChunksKeys HashSet (NonEmpty e)
referenceChunksKeys

    NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
nonEmptyPairs <-
      RowMismatchReason e
-> Maybe
     (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
-> Either
     (RowMismatchReason e)
     (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
forall a b. a -> Maybe b -> Either a b
maybeToEither RowMismatchReason e
forall e. RowMismatchReason e
EmptyIntersection (Maybe
   (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
 -> Either
      (RowMismatchReason e)
      (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))))
-> Maybe
     (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
-> Either
     (RowMismatchReason e)
     (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
forall a b. (a -> b) -> a -> b
$
        [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
-> Maybe
     (NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
sortedByAlignmentChoices

    let maybeViables :: Maybe NEIntSet
maybeViables = do
          NEIntSet
possibles <- (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
seedPossibleOffsets ((Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet)
-> (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
forall a b. (a -> b) -> a -> b
$ (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> (Int, FoundAndExpectedChunkPositions)
forall a b. (a, b) -> b
snd ((NonEmpty e, (Int, FoundAndExpectedChunkPositions))
 -> (Int, FoundAndExpectedChunkPositions))
-> (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> (Int, FoundAndExpectedChunkPositions)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
forall a. NonEmpty a -> a
NE.head NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
nonEmptyPairs
          (NEIntSet -> FoundAndExpectedChunkPositions -> Maybe NEIntSet)
-> NEIntSet
-> NonEmpty FoundAndExpectedChunkPositions
-> Maybe NEIntSet
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM NEIntSet -> FoundAndExpectedChunkPositions -> Maybe NEIntSet
findCoveringOffsets NEIntSet
possibles (NonEmpty FoundAndExpectedChunkPositions -> Maybe NEIntSet)
-> NonEmpty FoundAndExpectedChunkPositions -> Maybe NEIntSet
forall a b. (a -> b) -> a -> b
$ ((NonEmpty e, (Int, FoundAndExpectedChunkPositions))
 -> FoundAndExpectedChunkPositions)
-> NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> NonEmpty FoundAndExpectedChunkPositions
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ((Int, FoundAndExpectedChunkPositions)
-> FoundAndExpectedChunkPositions
forall a b. (a, b) -> b
snd ((Int, FoundAndExpectedChunkPositions)
 -> FoundAndExpectedChunkPositions)
-> ((NonEmpty e, (Int, FoundAndExpectedChunkPositions))
    -> (Int, FoundAndExpectedChunkPositions))
-> (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> FoundAndExpectedChunkPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> (Int, FoundAndExpectedChunkPositions)
forall a b. (a, b) -> b
snd) NonEmpty (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
nonEmptyPairs

    NEIntSet
viableRowOffsets <- RowMismatchReason e
-> Maybe NEIntSet -> Either (RowMismatchReason e) NEIntSet
forall a b. a -> Maybe b -> Either a b
maybeToEither RowMismatchReason e
forall e. RowMismatchReason e
EmptyIntersection Maybe NEIntSet
maybeViables
    NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)
-> Either
     (RowMismatchReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
forall a. a -> Either (RowMismatchReason e) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)
 -> Either
      (RowMismatchReason e)
      (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)))
-> NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)
-> Either
     (RowMismatchReason e)
     (NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
forall a b. (a -> b) -> a -> b
$ (Int -> ChunkedRowMatch (ConsolidatedRowReferences b e) e)
-> NonEmpty Int
-> NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Int -> ChunkedRowMatch (ConsolidatedRowReferences b e) e
mkRowMatch (NonEmpty Int
 -> NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
-> NonEmpty Int
-> NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e)
forall a b. (a -> b) -> a -> b
$ NEIntSet -> NonEmpty Int
NEIS.toList NEIntSet
viableRowOffsets
 where
  theIntersection :: HashMap (NonEmpty e) FoundAndExpectedChunkPositions
theIntersection =
    (NEIntSet -> NEIntSet -> FoundAndExpectedChunkPositions)
-> HashMap (NonEmpty e) NEIntSet
-> HashMap (NonEmpty e) NEIntSet
-> HashMap (NonEmpty e) FoundAndExpectedChunkPositions
forall k v1 v2 v3.
Eq k =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith
      NEIntSet -> NEIntSet -> FoundAndExpectedChunkPositions
FoundAndExpectedChunkPositions
      HashMap (NonEmpty e) NEIntSet
foundRowChunksLookup
      HashMap (NonEmpty e) NEIntSet
modifiedChunkPositionMap
  intersectionWithSizeDifferences :: HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
intersectionWithSizeDifferences = (FoundAndExpectedChunkPositions
 -> (Int, FoundAndExpectedChunkPositions))
-> HashMap (NonEmpty e) FoundAndExpectedChunkPositions
-> HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (FoundAndExpectedChunkPositions -> Int
sizeDifference (FoundAndExpectedChunkPositions -> Int)
-> (FoundAndExpectedChunkPositions
    -> FoundAndExpectedChunkPositions)
-> FoundAndExpectedChunkPositions
-> (Int, FoundAndExpectedChunkPositions)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FoundAndExpectedChunkPositions -> FoundAndExpectedChunkPositions
forall a. a -> a
id) HashMap (NonEmpty e) FoundAndExpectedChunkPositions
theIntersection
   where
    sizeDifference :: FoundAndExpectedChunkPositions -> Int
sizeDifference FoundAndExpectedChunkPositions
x = (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Int -> Int -> Int)
-> (NEIntSet -> Int) -> NEIntSet -> NEIntSet -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> Int
NEIS.size) (FoundAndExpectedChunkPositions -> NEIntSet
expectedPositions FoundAndExpectedChunkPositions
x) (FoundAndExpectedChunkPositions -> NEIntSet
foundPositions FoundAndExpectedChunkPositions
x)

  -- Remove the pairings that have fewer occurrences than the required number.
  -- The 'fst' element of the tuple is the difference between the "observed" and "required" count.
  withSufficientCoverage :: HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
withSufficientCoverage = ((Int, FoundAndExpectedChunkPositions) -> Bool)
-> HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
-> HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool)
-> ((Int, FoundAndExpectedChunkPositions) -> Int)
-> (Int, FoundAndExpectedChunkPositions)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, FoundAndExpectedChunkPositions) -> Int
forall a b. (a, b) -> a
fst) HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
intersectionWithSizeDifferences
  sortedByAlignmentChoices :: [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
sortedByAlignmentChoices = ((NonEmpty e, (Int, FoundAndExpectedChunkPositions)) -> Int)
-> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
-> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Int, FoundAndExpectedChunkPositions) -> Int
forall a b. (a, b) -> a
fst ((Int, FoundAndExpectedChunkPositions) -> Int)
-> ((NonEmpty e, (Int, FoundAndExpectedChunkPositions))
    -> (Int, FoundAndExpectedChunkPositions))
-> (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty e, (Int, FoundAndExpectedChunkPositions))
-> (Int, FoundAndExpectedChunkPositions)
forall a b. (a, b) -> b
snd) ([(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
 -> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))])
-> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
-> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
forall a b. (a -> b) -> a -> b
$ HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
-> [(NonEmpty e, (Int, FoundAndExpectedChunkPositions))]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap (NonEmpty e) (Int, FoundAndExpectedChunkPositions)
withSufficientCoverage

  isKeysSubset :: Bool
isKeysSubset = HashSet (NonEmpty e)
referenceChunksKeys HashSet (NonEmpty e) -> HashSet (NonEmpty e) -> Bool
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> Bool
`HS.isSubsetOf` HashSet (NonEmpty e)
foundChunksKeys

  mkRowMatch :: Int -> ChunkedRowMatch (ConsolidatedRowReferences b e) e
mkRowMatch Int
rowOffset =
    [(FoundAndExpectedChunkPositions, NonEmpty e)]
-> FoundRowFromChunk (ConsolidatedRowReferences b e)
-> ChunkedRowMatch (ConsolidatedRowReferences b e) e
forall a e.
[(FoundAndExpectedChunkPositions, NonEmpty e)]
-> FoundRowFromChunk a -> ChunkedRowMatch a e
ChunkedRowMatch
      (((NonEmpty e, FoundAndExpectedChunkPositions)
 -> (FoundAndExpectedChunkPositions, NonEmpty e))
-> [(NonEmpty e, FoundAndExpectedChunkPositions)]
-> [(FoundAndExpectedChunkPositions, NonEmpty e)]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty e, FoundAndExpectedChunkPositions)
-> (FoundAndExpectedChunkPositions, NonEmpty e)
forall a b. (a, b) -> (b, a)
swap ([(NonEmpty e, FoundAndExpectedChunkPositions)]
 -> [(FoundAndExpectedChunkPositions, NonEmpty e)])
-> [(NonEmpty e, FoundAndExpectedChunkPositions)]
-> [(FoundAndExpectedChunkPositions, NonEmpty e)]
forall a b. (a -> b) -> a -> b
$ HashMap (NonEmpty e) FoundAndExpectedChunkPositions
-> [(NonEmpty e, FoundAndExpectedChunkPositions)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap (NonEmpty e) FoundAndExpectedChunkPositions
theIntersection)
      (Int
-> Int32
-> ConsolidatedRowReferences b e
-> FoundRowFromChunk (ConsolidatedRowReferences b e)
forall a. Int -> Int32 -> a -> FoundRowFromChunk a
FoundRowFromChunk Int
rowOffset Int32
horizontalStructurePosition ConsolidatedRowReferences b e
r)
   where
    horizontalStructurePosition :: Int32
horizontalStructurePosition = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rowOffset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Min Int32 -> Int32
forall a. Min a -> a
getMin (InspectionOffsets -> Min Int32
startOffset InspectionOffsets
horizontalOffsets)

  modifiedChunkPositionMap :: HashMap (NonEmpty e) NEIntSet
modifiedChunkPositionMap = (NonEmpty Int -> NEIntSet)
-> HashMap (NonEmpty e) (NonEmpty Int)
-> HashMap (NonEmpty e) NEIntSet
forall a b.
(a -> b) -> HashMap (NonEmpty e) a -> HashMap (NonEmpty e) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Int -> NEIntSet
NEIS.fromList HashMap (NonEmpty e) (NonEmpty Int)
chunkPositionMap
  foundChunksKeys :: HashSet (NonEmpty e)
foundChunksKeys = HashMap (NonEmpty e) NEIntSet -> HashSet (NonEmpty e)
forall k a. HashMap k a -> HashSet k
HM.keysSet HashMap (NonEmpty e) NEIntSet
foundRowChunksLookup
  referenceChunksKeys :: HashSet (NonEmpty e)
referenceChunksKeys = HashMap (NonEmpty e) (NonEmpty Int) -> HashSet (NonEmpty e)
forall k a. HashMap k a -> HashSet k
HM.keysSet HashMap (NonEmpty e) (NonEmpty Int)
chunkPositionMap

-- | Search for any structure row that happens to
-- contain the placed entity.
registerRowMatches ::
  (Monoid (f (SearchLog a)), Applicative f, Monad s, Hashable a, Eq b) =>
  GenericEntLocator s a ->
  Cosmic Location ->
  AutomatonInfo b a ->
  FoundRegistry b a ->
  WriterT (f (SearchLog a)) s (FoundRegistry b a)
registerRowMatches :: forall (f :: * -> *) a (s :: * -> *) b.
(Monoid (f (SearchLog a)), Applicative f, Monad s, Hashable a,
 Eq b) =>
GenericEntLocator s a
-> Cosmic Location
-> AutomatonInfo b a
-> FoundRegistry b a
-> WriterT (f (SearchLog a)) s (FoundRegistry b a)
registerRowMatches GenericEntLocator s a
entLoader Cosmic Location
cLoc (AutomatonInfo InspectionOffsets
horizontalOffsets PiecewiseRecognition b a
pwMatcher) FoundRegistry b a
registry = do
  f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$ SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a)) -> SearchLog a -> f (SearchLog a)
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> InspectionOffsets -> SearchLog a
forall e. Cosmic Location -> InspectionOffsets -> SearchLog e
StartSearchAt Cosmic Location
cLoc InspectionOffsets
horizontalOffsets

  f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> (NonEmpty [NonEmpty a] -> f (SearchLog a))
-> NonEmpty [NonEmpty a]
-> WriterT (f (SearchLog a)) s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> (NonEmpty [NonEmpty a] -> SearchLog a)
-> NonEmpty [NonEmpty a]
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [NonEmpty a] -> SearchLog a
forall e. NonEmpty [NonEmpty e] -> SearchLog e
ExpectedChunks (NonEmpty [NonEmpty a] -> WriterT (f (SearchLog a)) s ())
-> NonEmpty [NonEmpty a] -> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$
    (RowChunkMatchingReference b a -> [NonEmpty a])
-> NonEmpty (RowChunkMatchingReference b a)
-> NonEmpty [NonEmpty a]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (HashMap (NonEmpty a) (NonEmpty Int) -> [NonEmpty a]
forall k v. HashMap k v -> [k]
HM.keys (HashMap (NonEmpty a) (NonEmpty Int) -> [NonEmpty a])
-> (RowChunkMatchingReference b a
    -> HashMap (NonEmpty a) (NonEmpty Int))
-> RowChunkMatchingReference b a
-> [NonEmpty a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowChunkMatchingReference b a
-> HashMap (NonEmpty a) (NonEmpty Int)
forall b a.
RowChunkMatchingReference b a
-> HashMap (NonEmpty a) (NonEmpty Int)
confirmationMap) NonEmpty (RowChunkMatchingReference b a)
rowChunkReferences

  [AtomicKeySymbol a]
entitiesRow <-
    s [AtomicKeySymbol a]
-> WriterT (f (SearchLog a)) s [AtomicKeySymbol a]
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (f (SearchLog a)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s [AtomicKeySymbol a]
 -> WriterT (f (SearchLog a)) s [AtomicKeySymbol a])
-> s [AtomicKeySymbol a]
-> WriterT (f (SearchLog a)) s [AtomicKeySymbol a]
forall a b. (a -> b) -> a -> b
$
      GenericEntLocator s a
-> FoundRegistry b a
-> Cosmic Location
-> InspectionOffsets
-> s [AtomicKeySymbol a]
forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
GenericEntLocator s a
-> FoundRegistry b a
-> Cosmic Location
-> InspectionOffsets
-> s [AtomicKeySymbol a]
getWorldRow
        GenericEntLocator s a
entLoader
        FoundRegistry b a
registry
        Cosmic Location
cLoc
        InspectionOffsets
horizontalOffsets

  f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> ([AtomicKeySymbol a] -> f (SearchLog a))
-> [AtomicKeySymbol a]
-> WriterT (f (SearchLog a)) s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> ([AtomicKeySymbol a] -> SearchLog a)
-> [AtomicKeySymbol a]
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AtomicKeySymbol a] -> SearchLog a
forall e. [Maybe e] -> SearchLog e
WorldRowContent ([AtomicKeySymbol a] -> WriterT (f (SearchLog a)) s ())
-> [AtomicKeySymbol a] -> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$ [AtomicKeySymbol a]
entitiesRow

  let candidatesChunked :: [Position (NonEmpty a)]
candidatesChunked = StateMachine (AtomicKeySymbol a) (NonEmpty a)
-> [AtomicKeySymbol a] -> [Position (NonEmpty a)]
forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> [keySymb] -> [Position val]
findAll StateMachine (AtomicKeySymbol a) (NonEmpty a)
pwSM [AtomicKeySymbol a]
entitiesRow
  [FoundStructure b a]
unrankedCandidateStructures <- [Position (NonEmpty a)]
-> WriterT (f (SearchLog a)) s [FoundStructure b a]
checkCombo [Position (NonEmpty a)]
candidatesChunked

  -- [STRUCTURE RECOGNIZER CONFLICT RESOLUTION]
  -- We only allow an entity to participate in one structure at a time,
  -- so multiple matches require a tie-breaker.
  -- The largest structure (by area) shall win.
  -- Sort by decreasing order of preference
  -- (see the Ord instance of 'FoundStructure').
  let rankedCandidates :: [FoundStructure b a]
rankedCandidates = (FoundStructure b a -> Down (FoundStructure b a))
-> [FoundStructure b a] -> [FoundStructure b a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn FoundStructure b a -> Down (FoundStructure b a)
forall a. a -> Down a
Down [FoundStructure b a]
unrankedCandidateStructures
  f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> ([(OrientedStructure, Cosmic Location)] -> f (SearchLog a))
-> [(OrientedStructure, Cosmic Location)]
-> WriterT (f (SearchLog a)) s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> ([(OrientedStructure, Cosmic Location)] -> SearchLog a)
-> [(OrientedStructure, Cosmic Location)]
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(OrientedStructure, Cosmic Location)] -> SearchLog a
forall e. [(OrientedStructure, Cosmic Location)] -> SearchLog e
FoundCompleteStructureCandidates ([(OrientedStructure, Cosmic Location)]
 -> WriterT (f (SearchLog a)) s ())
-> [(OrientedStructure, Cosmic Location)]
-> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$
    (FoundStructure b a -> (OrientedStructure, Cosmic Location))
-> [FoundStructure b a] -> [(OrientedStructure, Cosmic Location)]
forall a b. (a -> b) -> [a] -> [b]
map FoundStructure b a -> (OrientedStructure, Cosmic Location)
forall {b} {a}.
PositionedStructure (StructureWithGrid b a)
-> (OrientedStructure, Cosmic Location)
getStructInfo [FoundStructure b a]
rankedCandidates

  -- We should not check all of the structures, which can be expensive.
  -- Instead, we ranked the candidates by preference a-priori
  -- and now choose the first one that is verified.
  Maybe (FoundStructure b a)
maybeIntactStructure <- (FoundStructure b a -> WriterT (f (SearchLog a)) s Bool)
-> [FoundStructure b a]
-> WriterT (f (SearchLog a)) s (Maybe (FoundStructure b a))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM FoundStructure b a -> WriterT (f (SearchLog a)) s Bool
forall {f :: * -> *}.
(Monoid (f (SearchLog a)), Applicative f) =>
FoundStructure b a -> WriterT (f (SearchLog a)) s Bool
validateIntactness2d [FoundStructure b a]
rankedCandidates

  Maybe (FoundStructure b a)
-> (FoundStructure b a -> WriterT (f (SearchLog a)) s ())
-> WriterT (f (SearchLog a)) s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (FoundStructure b a)
maybeIntactStructure ((FoundStructure b a -> WriterT (f (SearchLog a)) s ())
 -> WriterT (f (SearchLog a)) s ())
-> (FoundStructure b a -> WriterT (f (SearchLog a)) s ())
-> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$
    f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> (FoundStructure b a -> f (SearchLog a))
-> FoundStructure b a
-> WriterT (f (SearchLog a)) s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> (FoundStructure b a -> SearchLog a)
-> FoundStructure b a
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrientedStructure, Cosmic Location) -> SearchLog a
forall e. (OrientedStructure, Cosmic Location) -> SearchLog e
RecognizedSingleStructure ((OrientedStructure, Cosmic Location) -> SearchLog a)
-> (FoundStructure b a -> (OrientedStructure, Cosmic Location))
-> FoundStructure b a
-> SearchLog a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundStructure b a -> (OrientedStructure, Cosmic Location)
forall {b} {a}.
PositionedStructure (StructureWithGrid b a)
-> (OrientedStructure, Cosmic Location)
getStructInfo

  FoundRegistry b a
-> WriterT (f (SearchLog a)) s (FoundRegistry b a)
forall a. a -> WriterT (f (SearchLog a)) s a
forall (m :: * -> *) a. Monad m => a -> m a
return (FoundRegistry b a
 -> WriterT (f (SearchLog a)) s (FoundRegistry b a))
-> FoundRegistry b a
-> WriterT (f (SearchLog a)) s (FoundRegistry b a)
forall a b. (a -> b) -> a -> b
$ (FoundRegistry b a -> FoundRegistry b a)
-> (FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a)
-> Maybe (FoundStructure b a)
-> FoundRegistry b a
-> FoundRegistry b a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FoundRegistry b a -> FoundRegistry b a
forall a. a -> a
id FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a
forall b a.
FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a
addFound Maybe (FoundStructure b a)
maybeIntactStructure FoundRegistry b a
registry
 where
  PiecewiseRecognition StateMachine (AtomicKeySymbol a) (NonEmpty a)
pwSM NonEmpty (RowChunkMatchingReference b a)
rowChunkReferences = PiecewiseRecognition b a
pwMatcher

  getStructInfo :: PositionedStructure (StructureWithGrid b a)
-> (OrientedStructure, Cosmic Location)
getStructInfo (PositionedStructure Cosmic Location
loc StructureWithGrid b a
swg) = (StructureWithGrid b a -> OrientedStructure
forall b a. StructureWithGrid b a -> OrientedStructure
distillLabel StructureWithGrid b a
swg, Cosmic Location
loc)

  validateIntactness2d :: FoundStructure b a -> WriterT (f (SearchLog a)) s Bool
validateIntactness2d FoundStructure b a
fs = do
    Maybe (StructureIntactnessFailure a)
maybeIntactnessFailure <- s (Maybe (StructureIntactnessFailure a))
-> WriterT
     (f (SearchLog a)) s (Maybe (StructureIntactnessFailure a))
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (f (SearchLog a)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s (Maybe (StructureIntactnessFailure a))
 -> WriterT
      (f (SearchLog a)) s (Maybe (StructureIntactnessFailure a)))
-> s (Maybe (StructureIntactnessFailure a))
-> WriterT
     (f (SearchLog a)) s (Maybe (StructureIntactnessFailure a))
forall a b. (a -> b) -> a -> b
$ FoundRegistry b a
-> GenericEntLocator s a
-> FoundStructure b a
-> s (Maybe (StructureIntactnessFailure a))
forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
FoundRegistry b a
-> GenericEntLocator s a
-> FoundStructure b a
-> s (Maybe (StructureIntactnessFailure a))
ensureStructureIntact FoundRegistry b a
registry GenericEntLocator s a
entLoader FoundStructure b a
fs
    f (SearchLog a) -> WriterT (f (SearchLog a)) s ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (f (SearchLog a) -> WriterT (f (SearchLog a)) s ())
-> (IntactPlacementLog a -> f (SearchLog a))
-> IntactPlacementLog a
-> WriterT (f (SearchLog a)) s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchLog a -> f (SearchLog a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchLog a -> f (SearchLog a))
-> (IntactPlacementLog a -> SearchLog a)
-> IntactPlacementLog a
-> f (SearchLog a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntactPlacementLog a -> SearchLog a
forall e. IntactPlacementLog e -> SearchLog e
ChunkIntactnessVerification
      (IntactPlacementLog a -> WriterT (f (SearchLog a)) s ())
-> IntactPlacementLog a -> WriterT (f (SearchLog a)) s ()
forall a b. (a -> b) -> a -> b
$ Maybe (StructureIntactnessFailure a)
-> PositionedStructure OrientedStructure -> IntactPlacementLog a
forall e.
Maybe (StructureIntactnessFailure e)
-> PositionedStructure OrientedStructure -> IntactPlacementLog e
IntactPlacementLog
        Maybe (StructureIntactnessFailure a)
maybeIntactnessFailure
      (PositionedStructure OrientedStructure -> IntactPlacementLog a)
-> PositionedStructure OrientedStructure -> IntactPlacementLog a
forall a b. (a -> b) -> a -> b
$ Cosmic Location
-> OrientedStructure -> PositionedStructure OrientedStructure
forall s. Cosmic Location -> s -> PositionedStructure s
PositionedStructure (FoundStructure b a -> Cosmic Location
forall s. PositionedStructure s -> Cosmic Location
upperLeftCorner FoundStructure b a
fs) (StructureWithGrid b a -> OrientedStructure
forall b a. StructureWithGrid b a -> OrientedStructure
distillLabel (StructureWithGrid b a -> OrientedStructure)
-> (FoundStructure b a -> StructureWithGrid b a)
-> FoundStructure b a
-> OrientedStructure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundStructure b a -> StructureWithGrid b a
forall s. PositionedStructure s -> s
structureWithGrid (FoundStructure b a -> OrientedStructure)
-> FoundStructure b a -> OrientedStructure
forall a b. (a -> b) -> a -> b
$ FoundStructure b a
fs)

    Bool -> WriterT (f (SearchLog a)) s Bool
forall a. a -> WriterT (f (SearchLog a)) s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> WriterT (f (SearchLog a)) s Bool)
-> Bool -> WriterT (f (SearchLog a)) s Bool
forall a b. (a -> b) -> a -> b
$ Maybe (StructureIntactnessFailure a) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (StructureIntactnessFailure a)
maybeIntactnessFailure

  checkCombo :: [Position (NonEmpty a)]
-> WriterT (f (SearchLog a)) s [FoundStructure b a]
checkCombo = Cosmic Location
-> InspectionOffsets
-> NonEmpty (RowChunkMatchingReference b a)
-> [Position (NonEmpty a)]
-> WriterT (f (SearchLog a)) s [FoundStructure b a]
forall (f :: * -> *) a (m :: * -> *) b.
(Monoid (f (SearchLog a)), Applicative f, Monad m, Hashable a,
 Eq b) =>
Cosmic Location
-> InspectionOffsets
-> NonEmpty (RowChunkMatchingReference b a)
-> [Position (NonEmpty a)]
-> WriterT (f (SearchLog a)) m [FoundStructure b a]
checkChunksCombination Cosmic Location
cLoc InspectionOffsets
horizontalOffsets NonEmpty (RowChunkMatchingReference b a)
rowChunkReferences

-- |
-- For a given "chunk", there could be multiple recurrences.
-- However, the position of each recurrence is unique
-- (i.e. the chunk cannot exist twice at the same location).
--
-- Either:
-- A) An observed chunk is "superfluous" w.r.t. matching the candidate, or
-- B) It is necessary for the match.
--
-- The lowest-numbered "reference position" (i.e. in the structure definition)
-- of a given chunk must align with exactly one "observed position".
--
-- The difference between the "observed" position of the chunk that aligns with the
-- lowest-numbered "reference position" shall be the global "row offset" applied to our observations.
-- This row offset value applies to all "chunks" (both identical and distinct) that comprise the row.
--
-- If a given chunk occurrence is necessary for the match, then we may attempt to use it to compute
-- the "row offset" by taking its position minus the lowest-numbered "reference position".
--
-- We can iterate over each occurrence position in ascending order.
-- In the ideal case, the first such candidate ends up being the the actual, valid, offset.
-- Otherwise, we know that all invalid offset candidates encountered before the first valid
-- offset constitute "superfluous" chunks.
--
-- Note that there may exist multiple valid "row offsets".
-- At most, there will be
--   {number of observed occurrences} minus {number of required occurrences}
-- such offsets.
--
-- = Performance notes
--
-- We only have to do this computation once, and only for the "smallest" size discrepancy
-- between occurrences and references of a chunk. This generates the "seed" pool of possible offsets.
-- All subsequent chunks will merely filter on this initial set.
seedPossibleOffsets :: (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
seedPossibleOffsets :: (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
seedPossibleOffsets (Int
sizeDifference, FoundAndExpectedChunkPositions NEIntSet
found NEIntSet
expected) =
  IntSet -> Maybe NEIntSet
NEIS.nonEmptySet (IntSet -> Maybe NEIntSet) -> IntSet -> Maybe NEIntSet
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
IS.fromList [Int]
possibleOffsets
 where
  possibleOffsets :: [Int]
possibleOffsets =
    Int -> NonEmpty Int -> [Int]
forall a. Int -> NonEmpty a -> [a]
NE.take (Int
sizeDifference Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (NonEmpty Int -> [Int]) -> NonEmpty Int -> [Int]
forall a b. (a -> b) -> a -> b
$
      (Int -> Int) -> NonEmpty Int -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (NEIntSet -> Int
NEIS.findMin NEIntSet
expected)) (NonEmpty Int -> NonEmpty Int) -> NonEmpty Int -> NonEmpty Int
forall a b. (a -> b) -> a -> b
$
        NEIntSet -> NonEmpty Int
NEIS.toAscList NEIntSet
found

-- | Return all of the offsets that are viable for repetitions of this chunk.
--
-- Note that if there are an equal number of observed occurrences
-- and expected occurrences, then there is only one possible offset.
-- If there are N expected and (N + 1) observed, then there are 2 possible offsets.
findCoveringOffsets :: NEIntSet -> FoundAndExpectedChunkPositions -> Maybe NEIntSet
findCoveringOffsets :: NEIntSet -> FoundAndExpectedChunkPositions -> Maybe NEIntSet
findCoveringOffsets NEIntSet
possibleOffsets FoundAndExpectedChunkPositions
x =
  IntSet -> Maybe NEIntSet
NEIS.nonEmptySet (IntSet -> Maybe NEIntSet) -> IntSet -> Maybe NEIntSet
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> NEIntSet -> IntSet
NEIS.filter (FoundAndExpectedChunkPositions -> Int -> Bool
isCoveredWithOffset FoundAndExpectedChunkPositions
x) NEIntSet
possibleOffsets

isCoveredWithOffset :: FoundAndExpectedChunkPositions -> Int -> Bool
isCoveredWithOffset :: FoundAndExpectedChunkPositions -> Int -> Bool
isCoveredWithOffset (FoundAndExpectedChunkPositions NEIntSet
found NEIntSet
expected) Int
offset =
  (Int -> Int) -> NEIntSet -> NEIntSet
NEIS.map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) NEIntSet
expected NEIntSet -> NEIntSet -> Bool
`NEIS.isSubsetOf` NEIntSet
found