-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (mkEntityLookup) where

import Control.Arrow ((&&&))
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.Hashable (Hashable)
import Data.Int (Int32)
import Data.List.NonEmpty qualified as NE
import Data.Maybe (catMaybes)
import Data.Semigroup (sconcat)
import Data.Tuple (swap)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Text.AhoCorasick

allStructureRows :: [StructureWithGrid b a] -> [StructureRow b a]
allStructureRows :: forall b a. [StructureWithGrid b a] -> [StructureRow b a]
allStructureRows =
  (StructureWithGrid b a -> [StructureRow b a])
-> [StructureWithGrid b a] -> [StructureRow b a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StructureWithGrid b a -> [StructureRow b a]
forall b a. StructureWithGrid b a -> [StructureRow b a]
transformRows
 where
  transformRows :: StructureWithGrid b a -> [StructureRow b a]
  transformRows :: forall b a. StructureWithGrid b a -> [StructureRow b a]
transformRows StructureWithGrid b a
g = (Int32 -> SymbolSequence a -> StructureRow b a)
-> [Int32] -> [SymbolSequence a] -> [StructureRow b a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (StructureWithGrid b a
-> Int32 -> SymbolSequence a -> StructureRow b a
forall b a.
StructureWithGrid b a
-> Int32 -> SymbolSequence a -> StructureRow b a
StructureRow StructureWithGrid b a
g) [Int32
0 ..] ([SymbolSequence a] -> [StructureRow b a])
-> [SymbolSequence a] -> [StructureRow b a]
forall a b. (a -> b) -> a -> b
$ StructureWithGrid b a -> [SymbolSequence a]
forall b a. StructureWithGrid b a -> [SymbolSequence a]
entityGrid StructureWithGrid b a
g

mkOffsets :: Foldable f => Int32 -> f a -> InspectionOffsets
mkOffsets :: forall (f :: * -> *) a.
Foldable f =>
Int32 -> f a -> InspectionOffsets
mkOffsets Int32
pos f a
xs =
  Min Int32 -> Max Int32 -> InspectionOffsets
InspectionOffsets (Int32 -> Min Int32
forall a. a -> Min a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Int32
forall a. Num a => a -> a
negate Int32
pos)) (Max Int32 -> InspectionOffsets) -> Max Int32 -> InspectionOffsets
forall a b. (a -> b) -> a -> b
$
    Int32 -> Max Int32
forall a. a -> Max a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Max Int32) -> Int32 -> Max Int32
forall a b. (a -> b) -> a -> b
$
      Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (f a -> Int
forall a. f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
xs) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
pos

-- | Given each possible row of entities observed in the world,
-- yield a searcher that can determine whether adjacent
-- rows constitute a complete structure.
mkRowLookup ::
  (Hashable a, Eq a) =>
  NE.NonEmpty (StructureRow b a) ->
  AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
mkRowLookup :: forall a b.
(Hashable a, Eq a) =>
NonEmpty (StructureRow b a)
-> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
mkRowLookup NonEmpty (StructureRow b a)
neList =
  HashSet a
-> InspectionOffsets
-> StateMachine (SymbolSequence a) (StructureWithGrid b a)
-> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
forall en k v.
HashSet en
-> InspectionOffsets -> StateMachine k v -> AutomatonInfo en k v
AutomatonInfo HashSet a
participatingEnts InspectionOffsets
bounds StateMachine (SymbolSequence a) (StructureWithGrid b a)
sm
 where
  mkSmTuple :: StructureWithGrid b a
-> ([SymbolSequence a], StructureWithGrid b a)
mkSmTuple = StructureWithGrid b a -> [SymbolSequence a]
forall b a. StructureWithGrid b a -> [SymbolSequence a]
entityGrid (StructureWithGrid b a -> [SymbolSequence a])
-> (StructureWithGrid b a -> StructureWithGrid b a)
-> StructureWithGrid b a
-> ([SymbolSequence a], StructureWithGrid b a)
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')
&&& StructureWithGrid b a -> StructureWithGrid b a
forall a. a -> a
id
  tuples :: [([SymbolSequence a], StructureWithGrid b a)]
tuples = NonEmpty ([SymbolSequence a], StructureWithGrid b a)
-> [([SymbolSequence a], StructureWithGrid b a)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ([SymbolSequence a], StructureWithGrid b a)
 -> [([SymbolSequence a], StructureWithGrid b a)])
-> NonEmpty ([SymbolSequence a], StructureWithGrid b a)
-> [([SymbolSequence a], StructureWithGrid b a)]
forall a b. (a -> b) -> a -> b
$ (StructureRow b a -> ([SymbolSequence a], StructureWithGrid b a))
-> NonEmpty (StructureRow b a)
-> NonEmpty ([SymbolSequence a], StructureWithGrid b a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (StructureWithGrid b a
-> ([SymbolSequence a], StructureWithGrid b a)
forall {b} {a}.
StructureWithGrid b a
-> ([SymbolSequence a], StructureWithGrid b a)
mkSmTuple (StructureWithGrid b a
 -> ([SymbolSequence a], StructureWithGrid b a))
-> (StructureRow b a -> StructureWithGrid b a)
-> StructureRow b a
-> ([SymbolSequence a], StructureWithGrid b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureRow b a -> StructureWithGrid b a
forall b a. StructureRow b a -> StructureWithGrid b a
wholeStructure) NonEmpty (StructureRow b a)
neList

  -- All of the unique entities across all of the full candidate structures
  participatingEnts :: HashSet a
participatingEnts =
    [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([a] -> HashSet a) -> [a] -> HashSet a
forall a b. (a -> b) -> a -> b
$
      (([SymbolSequence a], StructureWithGrid b a) -> [a])
-> [([SymbolSequence a], StructureWithGrid b a)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SymbolSequence a -> [a]) -> [SymbolSequence a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SymbolSequence a -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([SymbolSequence a] -> [a])
-> (([SymbolSequence a], StructureWithGrid b a)
    -> [SymbolSequence a])
-> ([SymbolSequence a], StructureWithGrid b a)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymbolSequence a], StructureWithGrid b a) -> [SymbolSequence a]
forall a b. (a, b) -> a
fst) [([SymbolSequence a], StructureWithGrid b a)]
tuples

  deriveRowOffsets :: StructureRow b a -> InspectionOffsets
  deriveRowOffsets :: forall b a. StructureRow b a -> InspectionOffsets
deriveRowOffsets (StructureRow (StructureWithGrid NamedOriginal b
_ AbsoluteDir
_ [SymbolSequence a]
g) Int32
rwIdx SymbolSequence a
_) =
    Int32 -> [SymbolSequence a] -> InspectionOffsets
forall (f :: * -> *) a.
Foldable f =>
Int32 -> f a -> InspectionOffsets
mkOffsets Int32
rwIdx [SymbolSequence a]
g

  bounds :: InspectionOffsets
bounds = NonEmpty InspectionOffsets -> InspectionOffsets
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty InspectionOffsets -> InspectionOffsets)
-> NonEmpty InspectionOffsets -> InspectionOffsets
forall a b. (a -> b) -> a -> b
$ (StructureRow b a -> InspectionOffsets)
-> NonEmpty (StructureRow b a) -> NonEmpty InspectionOffsets
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map StructureRow b a -> InspectionOffsets
forall b a. StructureRow b a -> InspectionOffsets
deriveRowOffsets NonEmpty (StructureRow b a)
neList
  sm :: StateMachine (SymbolSequence a) (StructureWithGrid b a)
sm = [([SymbolSequence a], StructureWithGrid b a)]
-> StateMachine (SymbolSequence a) (StructureWithGrid b a)
forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
[([keySymb], val)] -> StateMachine keySymb val
makeStateMachine [([SymbolSequence a], StructureWithGrid b a)]
tuples

-- | Make the first-phase lookup map, keyed by 'Entity',
-- along with automatons whose key symbols are "Maybe Entity".
--
-- Each automaton in this first layer will attempt to match the
-- underlying world row against all rows within all structures
-- (so long as they contain the keyed entity).
mkEntityLookup ::
  (Hashable a, Eq a) =>
  [StructureWithGrid b a] ->
  HM.HashMap a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
mkEntityLookup :: forall a b.
(Hashable a, Eq a) =>
[StructureWithGrid b a]
-> HashMap
     a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
mkEntityLookup [StructureWithGrid b a]
grids =
  (NonEmpty (SingleRowEntityOccurrences b a)
 -> AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
-> HashMap a (NonEmpty (SingleRowEntityOccurrences b a))
-> HashMap
     a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map NonEmpty (SingleRowEntityOccurrences b a)
-> AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)
forall {en} {b}.
Hashable en =>
NonEmpty (SingleRowEntityOccurrences b en)
-> AutomatonInfo en (AtomicKeySymbol en) (StructureSearcher b en)
mkValues HashMap a (NonEmpty (SingleRowEntityOccurrences b a))
rowsByEntityParticipation
 where
  rowsAcrossAllStructures :: [StructureRow b a]
rowsAcrossAllStructures = [StructureWithGrid b a] -> [StructureRow b a]
forall b a. [StructureWithGrid b a] -> [StructureRow b a]
allStructureRows [StructureWithGrid b a]
grids

  -- The input here are all rows across all structures
  -- that share the same entity sequence.
  mkSmValue :: SymbolSequence a
-> NonEmpty (SingleRowEntityOccurrences b a)
-> StructureSearcher b a
mkSmValue SymbolSequence a
ksms NonEmpty (SingleRowEntityOccurrences b a)
singleRows =
    AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
-> SymbolSequence a
-> NonEmpty (SingleRowEntityOccurrences b a)
-> StructureSearcher b a
forall b a.
AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
-> SymbolSequence a
-> NonEmpty (SingleRowEntityOccurrences b a)
-> StructureSearcher b a
StructureSearcher AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
sm2D SymbolSequence a
ksms NonEmpty (SingleRowEntityOccurrences b a)
singleRows
   where
    structureRowsNE :: NonEmpty (StructureRow b a)
structureRowsNE = (SingleRowEntityOccurrences b a -> StructureRow b a)
-> NonEmpty (SingleRowEntityOccurrences b a)
-> NonEmpty (StructureRow b a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map SingleRowEntityOccurrences b a -> StructureRow b a
forall b a. SingleRowEntityOccurrences b a -> StructureRow b a
myRow NonEmpty (SingleRowEntityOccurrences b a)
singleRows
    sm2D :: AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
sm2D = NonEmpty (StructureRow b a)
-> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
forall a b.
(Hashable a, Eq a) =>
NonEmpty (StructureRow b a)
-> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
mkRowLookup NonEmpty (StructureRow b a)
structureRowsNE

  mkValues :: NonEmpty (SingleRowEntityOccurrences b en)
-> AutomatonInfo en (AtomicKeySymbol en) (StructureSearcher b en)
mkValues NonEmpty (SingleRowEntityOccurrences b en)
neList = HashSet en
-> InspectionOffsets
-> StateMachine (AtomicKeySymbol en) (StructureSearcher b en)
-> AutomatonInfo en (AtomicKeySymbol en) (StructureSearcher b en)
forall en k v.
HashSet en
-> InspectionOffsets -> StateMachine k v -> AutomatonInfo en k v
AutomatonInfo HashSet en
participatingEnts InspectionOffsets
bounds StateMachine (AtomicKeySymbol en) (StructureSearcher b en)
sm
   where
    participatingEnts :: HashSet en
participatingEnts =
      [en] -> HashSet en
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList
        ((([AtomicKeySymbol en], StructureSearcher b en) -> [en])
-> [([AtomicKeySymbol en], StructureSearcher b en)] -> [en]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([AtomicKeySymbol en] -> [en]
forall a. [Maybe a] -> [a]
catMaybes ([AtomicKeySymbol en] -> [en])
-> (([AtomicKeySymbol en], StructureSearcher b en)
    -> [AtomicKeySymbol en])
-> ([AtomicKeySymbol en], StructureSearcher b en)
-> [en]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AtomicKeySymbol en], StructureSearcher b en)
-> [AtomicKeySymbol en]
forall a b. (a, b) -> a
fst) [([AtomicKeySymbol en], StructureSearcher b en)]
tuples)

    tuples :: [([AtomicKeySymbol en], StructureSearcher b en)]
tuples = HashMap [AtomicKeySymbol en] (StructureSearcher b en)
-> [([AtomicKeySymbol en], StructureSearcher b en)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap [AtomicKeySymbol en] (StructureSearcher b en)
 -> [([AtomicKeySymbol en], StructureSearcher b en)])
-> HashMap [AtomicKeySymbol en] (StructureSearcher b en)
-> [([AtomicKeySymbol en], StructureSearcher b en)]
forall a b. (a -> b) -> a -> b
$ ([AtomicKeySymbol en]
 -> NonEmpty (SingleRowEntityOccurrences b en)
 -> StructureSearcher b en)
-> HashMap
     [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en))
-> HashMap [AtomicKeySymbol en] (StructureSearcher b en)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey [AtomicKeySymbol en]
-> NonEmpty (SingleRowEntityOccurrences b en)
-> StructureSearcher b en
forall {a} {b}.
Hashable a =>
SymbolSequence a
-> NonEmpty (SingleRowEntityOccurrences b a)
-> StructureSearcher b a
mkSmValue HashMap
  [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en))
groupedByUniqueRow

    groupedByUniqueRow :: HashMap
  [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en))
groupedByUniqueRow = [([AtomicKeySymbol en], SingleRowEntityOccurrences b en)]
-> HashMap
     [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en))
forall (t :: * -> *) a b.
(Foldable t, Hashable a, Eq a) =>
t (a, b) -> HashMap a (NonEmpty b)
binTuplesHM ([([AtomicKeySymbol en], SingleRowEntityOccurrences b en)]
 -> HashMap
      [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en)))
-> [([AtomicKeySymbol en], SingleRowEntityOccurrences b en)]
-> HashMap
     [AtomicKeySymbol en] (NonEmpty (SingleRowEntityOccurrences b en))
forall a b. (a -> b) -> a -> b
$ NonEmpty ([AtomicKeySymbol en], SingleRowEntityOccurrences b en)
-> [([AtomicKeySymbol en], SingleRowEntityOccurrences b en)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ([AtomicKeySymbol en], SingleRowEntityOccurrences b en)
 -> [([AtomicKeySymbol en], SingleRowEntityOccurrences b en)])
-> NonEmpty ([AtomicKeySymbol en], SingleRowEntityOccurrences b en)
-> [([AtomicKeySymbol en], SingleRowEntityOccurrences b en)]
forall a b. (a -> b) -> a -> b
$ (SingleRowEntityOccurrences b en
 -> ([AtomicKeySymbol en], SingleRowEntityOccurrences b en))
-> NonEmpty (SingleRowEntityOccurrences b en)
-> NonEmpty ([AtomicKeySymbol en], SingleRowEntityOccurrences b en)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (StructureRow b en -> [AtomicKeySymbol en]
forall b a. StructureRow b a -> SymbolSequence a
rowContent (StructureRow b en -> [AtomicKeySymbol en])
-> (SingleRowEntityOccurrences b en -> StructureRow b en)
-> SingleRowEntityOccurrences b en
-> [AtomicKeySymbol en]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRowEntityOccurrences b en -> StructureRow b en
forall b a. SingleRowEntityOccurrences b a -> StructureRow b a
myRow (SingleRowEntityOccurrences b en -> [AtomicKeySymbol en])
-> (SingleRowEntityOccurrences b en
    -> SingleRowEntityOccurrences b en)
-> SingleRowEntityOccurrences b en
-> ([AtomicKeySymbol en], SingleRowEntityOccurrences b en)
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')
&&& SingleRowEntityOccurrences b en -> SingleRowEntityOccurrences b en
forall a. a -> a
id) NonEmpty (SingleRowEntityOccurrences b en)
neList
    bounds :: InspectionOffsets
bounds = NonEmpty InspectionOffsets -> InspectionOffsets
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty InspectionOffsets -> InspectionOffsets)
-> NonEmpty InspectionOffsets -> InspectionOffsets
forall a b. (a -> b) -> a -> b
$ (SingleRowEntityOccurrences b en -> InspectionOffsets)
-> NonEmpty (SingleRowEntityOccurrences b en)
-> NonEmpty InspectionOffsets
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map SingleRowEntityOccurrences b en -> InspectionOffsets
forall b a. SingleRowEntityOccurrences b a -> InspectionOffsets
expandedOffsets NonEmpty (SingleRowEntityOccurrences b en)
neList
    sm :: StateMachine (AtomicKeySymbol en) (StructureSearcher b en)
sm = [([AtomicKeySymbol en], StructureSearcher b en)]
-> StateMachine (AtomicKeySymbol en) (StructureSearcher b en)
forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
[([keySymb], val)] -> StateMachine keySymb val
makeStateMachine [([AtomicKeySymbol en], StructureSearcher b en)]
tuples

  -- The values of this map are guaranteed to contain only one
  -- entry per row of a given structure.
  rowsByEntityParticipation :: HashMap a (NonEmpty (SingleRowEntityOccurrences b a))
rowsByEntityParticipation =
    [(a, SingleRowEntityOccurrences b a)]
-> HashMap a (NonEmpty (SingleRowEntityOccurrences b a))
forall (t :: * -> *) a b.
(Foldable t, Hashable a, Eq a) =>
t (a, b) -> HashMap a (NonEmpty b)
binTuplesHM ([(a, SingleRowEntityOccurrences b a)]
 -> HashMap a (NonEmpty (SingleRowEntityOccurrences b a)))
-> [(a, SingleRowEntityOccurrences b a)]
-> HashMap a (NonEmpty (SingleRowEntityOccurrences b a))
forall a b. (a -> b) -> a -> b
$
      (SingleRowEntityOccurrences b a
 -> (a, SingleRowEntityOccurrences b a))
-> [SingleRowEntityOccurrences b a]
-> [(a, SingleRowEntityOccurrences b a)]
forall a b. (a -> b) -> [a] -> [b]
map (SingleRowEntityOccurrences b a -> a
forall b a. SingleRowEntityOccurrences b a -> a
myEntity (SingleRowEntityOccurrences b a -> a)
-> (SingleRowEntityOccurrences b a
    -> SingleRowEntityOccurrences b a)
-> SingleRowEntityOccurrences b a
-> (a, SingleRowEntityOccurrences b a)
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')
&&& SingleRowEntityOccurrences b a -> SingleRowEntityOccurrences b a
forall a. a -> a
id) ([SingleRowEntityOccurrences b a]
 -> [(a, SingleRowEntityOccurrences b a)])
-> [SingleRowEntityOccurrences b a]
-> [(a, SingleRowEntityOccurrences b a)]
forall a b. (a -> b) -> a -> b
$
        (StructureRow b a -> [SingleRowEntityOccurrences b a])
-> [StructureRow b a] -> [SingleRowEntityOccurrences b a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StructureRow b a -> [SingleRowEntityOccurrences b a]
forall a b.
(Hashable a, Eq a) =>
StructureRow b a -> [SingleRowEntityOccurrences b a]
explodeRowEntities [StructureRow b a]
rowsAcrossAllStructures

  deriveEntityOffsets :: PositionWithinRow b a -> InspectionOffsets
  deriveEntityOffsets :: forall b a. PositionWithinRow b a -> InspectionOffsets
deriveEntityOffsets (PositionWithinRow Int32
pos StructureRow b a
r) =
    Int32 -> [AtomicKeySymbol a] -> InspectionOffsets
forall (f :: * -> *) a.
Foldable f =>
Int32 -> f a -> InspectionOffsets
mkOffsets Int32
pos ([AtomicKeySymbol a] -> InspectionOffsets)
-> [AtomicKeySymbol a] -> InspectionOffsets
forall a b. (a -> b) -> a -> b
$ StructureRow b a -> [AtomicKeySymbol a]
forall b a. StructureRow b a -> SymbolSequence a
rowContent StructureRow b a
r

  -- The members of "rowMembers" are of 'Maybe' type; the 'Nothing's
  -- are dropped but accounted for when indexing the columns.
  explodeRowEntities ::
    (Hashable a, Eq a) =>
    StructureRow b a ->
    [SingleRowEntityOccurrences b a]
  explodeRowEntities :: forall a b.
(Hashable a, Eq a) =>
StructureRow b a -> [SingleRowEntityOccurrences b a]
explodeRowEntities r :: StructureRow b a
r@(StructureRow StructureWithGrid b a
_ Int32
_ SymbolSequence a
rowMembers) =
    ((a, NonEmpty (PositionWithinRow b a))
 -> SingleRowEntityOccurrences b a)
-> [(a, NonEmpty (PositionWithinRow b a))]
-> [SingleRowEntityOccurrences b a]
forall a b. (a -> b) -> [a] -> [b]
map (a, NonEmpty (PositionWithinRow b a))
-> SingleRowEntityOccurrences b a
f ([(a, NonEmpty (PositionWithinRow b a))]
 -> [SingleRowEntityOccurrences b a])
-> [(a, NonEmpty (PositionWithinRow b a))]
-> [SingleRowEntityOccurrences b a]
forall a b. (a -> b) -> a -> b
$ HashMap a (NonEmpty (PositionWithinRow b a))
-> [(a, NonEmpty (PositionWithinRow b a))]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap a (NonEmpty (PositionWithinRow b a))
 -> [(a, NonEmpty (PositionWithinRow b a))])
-> HashMap a (NonEmpty (PositionWithinRow b a))
-> [(a, NonEmpty (PositionWithinRow b a))]
forall a b. (a -> b) -> a -> b
$ [(a, PositionWithinRow b a)]
-> HashMap a (NonEmpty (PositionWithinRow b a))
forall (t :: * -> *) a b.
(Foldable t, Hashable a, Eq a) =>
t (a, b) -> HashMap a (NonEmpty b)
binTuplesHM [(a, PositionWithinRow b a)]
unconsolidated
   where
    f :: (a, NonEmpty (PositionWithinRow b a))
-> SingleRowEntityOccurrences b a
f (a
e, NonEmpty (PositionWithinRow b a)
occurrences) =
      StructureRow b a
-> a
-> NonEmpty (PositionWithinRow b a)
-> InspectionOffsets
-> SingleRowEntityOccurrences b a
forall b a.
StructureRow b a
-> a
-> NonEmpty (PositionWithinRow b a)
-> InspectionOffsets
-> SingleRowEntityOccurrences b a
SingleRowEntityOccurrences StructureRow b a
r a
e NonEmpty (PositionWithinRow b a)
occurrences (InspectionOffsets -> SingleRowEntityOccurrences b a)
-> InspectionOffsets -> SingleRowEntityOccurrences b a
forall a b. (a -> b) -> a -> b
$
        NonEmpty InspectionOffsets -> InspectionOffsets
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty InspectionOffsets -> InspectionOffsets)
-> NonEmpty InspectionOffsets -> InspectionOffsets
forall a b. (a -> b) -> a -> b
$
          (PositionWithinRow b a -> InspectionOffsets)
-> NonEmpty (PositionWithinRow b a) -> NonEmpty InspectionOffsets
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map PositionWithinRow b a -> InspectionOffsets
forall b a. PositionWithinRow b a -> InspectionOffsets
deriveEntityOffsets NonEmpty (PositionWithinRow b a)
occurrences
    unconsolidated :: [(a, PositionWithinRow b a)]
unconsolidated =
      ((PositionWithinRow b a, a) -> (a, PositionWithinRow b a))
-> [(PositionWithinRow b a, a)] -> [(a, PositionWithinRow b a)]
forall a b. (a -> b) -> [a] -> [b]
map (PositionWithinRow b a, a) -> (a, PositionWithinRow b a)
forall a b. (a, b) -> (b, a)
swap ([(PositionWithinRow b a, a)] -> [(a, PositionWithinRow b a)])
-> [(PositionWithinRow b a, a)] -> [(a, PositionWithinRow b a)]
forall a b. (a -> b) -> a -> b
$
        [Maybe (PositionWithinRow b a, a)] -> [(PositionWithinRow b a, a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PositionWithinRow b a, a)]
 -> [(PositionWithinRow b a, a)])
-> [Maybe (PositionWithinRow b a, a)]
-> [(PositionWithinRow b a, a)]
forall a b. (a -> b) -> a -> b
$
          (Int32 -> Maybe a -> Maybe (PositionWithinRow b a, a))
-> [Int32]
-> SymbolSequence a
-> [Maybe (PositionWithinRow b a, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int32
idx -> (a -> (PositionWithinRow b a, a))
-> Maybe a -> Maybe (PositionWithinRow b a, a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> StructureRow b a -> PositionWithinRow b a
forall b a. Int32 -> StructureRow b a -> PositionWithinRow b a
PositionWithinRow Int32
idx StructureRow b a
r,)) [Int32
0 ..] SymbolSequence a
rowMembers

-- * Util

-- | Place the second element of the tuples into bins by
-- the value of the first element.
binTuplesHM ::
  (Foldable t, Hashable a, Eq a) =>
  t (a, b) ->
  HM.HashMap a (NE.NonEmpty b)
binTuplesHM :: forall (t :: * -> *) a b.
(Foldable t, Hashable a, Eq a) =>
t (a, b) -> HashMap a (NonEmpty b)
binTuplesHM = ((a, b) -> HashMap a (NonEmpty b) -> HashMap a (NonEmpty b))
-> HashMap a (NonEmpty b) -> t (a, b) -> HashMap a (NonEmpty b)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b) -> HashMap a (NonEmpty b) -> HashMap a (NonEmpty b)
f HashMap a (NonEmpty b)
forall a. Monoid a => a
mempty
 where
  f :: (a, b) -> HashMap a (NonEmpty b) -> HashMap a (NonEmpty b)
f = (a
 -> NonEmpty b -> HashMap a (NonEmpty b) -> HashMap a (NonEmpty b))
-> (a, NonEmpty b)
-> HashMap a (NonEmpty b)
-> HashMap a (NonEmpty b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NonEmpty b -> NonEmpty b -> NonEmpty b)
-> a
-> NonEmpty b
-> HashMap a (NonEmpty b)
-> HashMap a (NonEmpty b)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith NonEmpty b -> NonEmpty b -> NonEmpty b
forall a. Semigroup a => a -> a -> a
(<>)) ((a, NonEmpty b)
 -> HashMap a (NonEmpty b) -> HashMap a (NonEmpty b))
-> ((a, b) -> (a, NonEmpty b))
-> (a, b)
-> HashMap a (NonEmpty b)
-> HashMap a (NonEmpty b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> NonEmpty b) -> (a, b) -> (a, NonEmpty b)
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> NonEmpty b
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure