{-|
Module      : Tgraph.Force
Description : The force functions for Tgraphs 
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

This module includes force and tryForce plus related operations for testing and experimenting
such as tryStepForce, tryAddHalfKite and tryAddHalfDart.
It introduces BoundaryState and ForceState types and includes a Forcible class with instances for
Tgraph, BoundaryState, and ForceState.
It exposes the calculation of relative angle of edges at boundary vertices used to find existing edges.
It imports a touching check for adding new vertices (with locateVertices and addVPoint).
-}

module Tgraph.Force
  (-- *  Touching vertex checking
    touchCheck
    -- *  BoundaryState operations
  , BoundaryState(..)
  , makeBoundaryState
  , recoverGraph
  , changeVFMap
  , facesAtBV
  , boundaryFaces
    -- *  Types: Update, UpdateMap, UpdateGenerator, ForceState
  , Update(..)
  , UpdateMap
  , ForceState(..)
  , UpdateGenerator
    -- *  Forcible class and Instances (ForceState, BoundaryState, Tgraph)
  , Forcible(..)
    -- *  Generalised forcing operations
  , tryForceWith
  , tryStepForceWith
  , tryFSOp
  , tryForce
  , force
  , wholeTiles
  , forceWith
  , tryInitFS
  , initFS
  , tryStepForce
  , stepForce
  , tryChangeBoundary
    -- *  Force Related Functions
  , addHalfKite
  , tryAddHalfKite
  , addHalfDart
  , tryAddHalfDart
    -- *  Specialised forcing operations (used for inspecting steps)
  , tryOneStepWith
  , tryOneStepF
    -- *  Updating BoundaryState and ForceState after a single force step
  , BoundaryChange(..)
  , affectedBoundary
--  , mustFind
  , tryReviseUpdates
  , tryReviseFSWith
    -- *  Auxiliary Functions for doing a force step
  , findSafeUpdate
  , tryUnsafes
  , checkUnsafeUpdate
  , trySafeUpdate
--   , commonVs
  , tryUpdate
    -- *  Recalibrating versions of force and tryForce
  , recalculateBVLocs
  , tryRecalibratingForce
  , recalibratingForce
    -- *  Main All Update Generators
  , defaultAllUGen
  , allUGenerator
   -- * Tools for making update generators
  , UFinder
  , UChecker
  , boundaryFilter
  , makeUpdate
  , makeGenerator 
    -- *  BoundaryState vertex predicates and properties
  , mustbeStar
  , mustbeSun
  , mustbeDeuce
  , mustbeKing
  , isKiteWing
  , isKiteOppV
  , isDartOrigin
  , mustbeQueen
  , kiteWingCount
  , mustbeJack
--  , hasAnyMatchingE
    -- * Forcing Rules and Individual Update Generators (with corresponding Finders) for each rule.
    --  $rules
  , wholeTileUpdates
  , incompleteHalves
  , aceKiteUpdates
  , nonKDarts
  , queenOrKingUpdates
  , kitesWingDartOrigin
  , deuceDartUpdates
  , kiteGaps
  , jackDartUpdates
  , noTouchingDart
  , sunStarUpdates
  , almostSunStar
  , jackKiteUpdates
  , jackMissingKite
  , kingDartUpdates
  , kingMissingThirdDart
  , queenDartUpdates
  , queenMissingDarts
  , queenKiteUpdates
  , queenMissingKite
    -- *  Six Update Checkers
  , completeHalf
  , addKiteShortE
  , addDartShortE
  , completeSunStar
  , addKiteLongE
  , addDartLongE
{-
  , anglesForJoinRD
  , anglesForJoinLD
  , anglesForJoinRK
  , anglesForJoinLK
  , anglesForLongLD
  , anglesForLongRD
  , anglesForLongRK
  , anglesForLongLK
  , anglesForShortLD
  , anglesForShortRD
  , anglesForShortLK
  , anglesForShortRK
-}
--   , inspectBDedge
    -- *  Auxiliary Functions for adding faces: externalAngle and tryFindThirdV. $Additions
  , tryFindThirdV
  , externalAngle
{-
  , intAngleAt
  , faceIntAngles
-}
  )  where

import Data.List ((\\), intersect, nub, find,foldl')
import qualified Data.Map as Map (Map, empty, delete, elems, insert, union, keys) -- used for UpdateMap
import qualified Data.IntMap.Strict as VMap (elems, filterWithKey, alter, delete, lookup, (!))
            -- used for BoundaryState locations AND faces at boundary vertices
import Diagrams.Prelude (Point, V2) -- necessary for touch check (touchCheck) used in tryUnsafeUpdate 
-- import Tgraph.Convert(touching, locateVertices, addVPoint)
import Tgraph.Prelude

{-
***************************************************************************   
Efficient FORCING with 
  BoundaryState, ForceState 
  Touching Vertex Check
  Incremented Update Maps
***************************************************************************
-}



{-------------------------
*************************             
Touching vertex checking 
********************************************
requires Diagrams.Prelude for Point and V2
--------------------------------------------}

-- |touchCheck p vpMap - check if a vertex location p touches (is too close to) any other vertex location in the mapping vpMap
touchCheck:: Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck :: Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck Point V2 Double
p VertexMap (Point V2 Double)
vpMap = (Point V2 Double -> Bool) -> [Point V2 Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point V2 Double -> Point V2 Double -> Bool
touching Point V2 Double
p) (VertexMap (Point V2 Double) -> [Point V2 Double]
forall a. IntMap a -> [a]
VMap.elems VertexMap (Point V2 Double)
vpMap)


{-| A BoundaryState records
the boundary directed edges (directed so that faces are on LHS and exterior is on RHS)
plus 
a mapping of boundary vertices to their incident faces, plus
a mapping of boundary vertices to positions (using Tgraph.Prelude.locateVertices).
It also keeps track of all the faces
and the next vertex label to be used when adding a new vertex.
-}
data BoundaryState 
   = BoundaryState
     { BoundaryState -> [(Vertex, Vertex)]
boundary:: [Dedge]  -- ^ boundary directed edges (face on LHS, exterior on RHS)
     , BoundaryState -> VertexMap [TileFace]
bvFacesMap:: VertexMap [TileFace] -- ^faces at each boundary vertex.
     , BoundaryState -> VertexMap (Point V2 Double)
bvLocMap:: VertexMap (Point V2 Double)  -- ^ position of each boundary vertex.
     , BoundaryState -> [TileFace]
allFaces:: [TileFace] -- ^ all the tile faces
     , BoundaryState -> Vertex
nextVertex:: Vertex -- ^ next vertex number
     } deriving (Vertex -> BoundaryState -> ShowS
[BoundaryState] -> ShowS
BoundaryState -> String
(Vertex -> BoundaryState -> ShowS)
-> (BoundaryState -> String)
-> ([BoundaryState] -> ShowS)
-> Show BoundaryState
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> BoundaryState -> ShowS
showsPrec :: Vertex -> BoundaryState -> ShowS
$cshow :: BoundaryState -> String
show :: BoundaryState -> String
$cshowList :: [BoundaryState] -> ShowS
showList :: [BoundaryState] -> ShowS
Show)

-- |Calculates BoundaryState information from a Tgraph
-- also checks for no crossing boundaries as these could cause difficult to trace errors in forcing.
makeBoundaryState:: Tgraph -> BoundaryState
makeBoundaryState :: Tgraph -> BoundaryState
makeBoundaryState Tgraph
g = 
  let bdes :: [(Vertex, Vertex)]
bdes = Tgraph -> [(Vertex, Vertex)]
graphBoundary Tgraph
g
      bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst [(Vertex, Vertex)]
bdes -- (fmap snd bdes would also do) for all boundary vertices
      bvLocs :: VertexMap (Point V2 Double)
bvLocs = (Vertex -> Point V2 Double -> Bool)
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. (Vertex -> a -> Bool) -> IntMap a -> IntMap a
VMap.filterWithKey (\Vertex
k Point V2 Double
_ -> Vertex
k Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vertex]
bvs) (VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexMap (Point V2 Double)
locateVertices ([TileFace] -> VertexMap (Point V2 Double))
-> [TileFace] -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
faces Tgraph
g
  in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Vertex] -> Bool) -> [Vertex] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> [Vertex]
crossingVertices [(Vertex, Vertex)]
bdes then String -> BoundaryState
forall a. HasCallStack => String -> a
error (String -> BoundaryState) -> String -> BoundaryState
forall a b. (a -> b) -> a -> b
$ String
"makeBoundaryState: found crossing boundary in faces:\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++[TileFace] -> String
forall a. Show a => a -> String
show (Tgraph -> [TileFace]
faces Tgraph
g)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n"
     else
      BoundaryState
      { boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
bdes
      , bvFacesMap :: VertexMap [TileFace]
bvFacesMap = [Vertex] -> [TileFace] -> VertexMap [TileFace]
vertexFacesMap [Vertex]
bvs (Tgraph -> [TileFace]
faces Tgraph
g)
      , bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
bvLocs 
      , allFaces :: [TileFace]
allFaces = Tgraph -> [TileFace]
faces Tgraph
g
      , nextVertex :: Vertex
nextVertex = Vertex
1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+ Tgraph -> Vertex
maxV Tgraph
g
      }
      
-- |Converts a BoundaryState back to a Tgraph
recoverGraph:: BoundaryState -> Tgraph
recoverGraph :: BoundaryState -> Tgraph
recoverGraph BoundaryState
bd = [TileFace] -> Tgraph
makeUncheckedTgraph (BoundaryState -> [TileFace]
allFaces BoundaryState
bd)

-- |changeVFMap f vfmap - adds f to the list of faces associated with each v in f, returning a revised vfmap
changeVFMap::  TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap :: TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
f VertexMap [TileFace]
vfm = (VertexMap [TileFace] -> Vertex -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [Vertex] -> VertexMap [TileFace]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' VertexMap [TileFace] -> Vertex -> VertexMap [TileFace]
insertf VertexMap [TileFace]
vfm (TileFace -> [Vertex]
faceVList TileFace
f) where
   insertf :: VertexMap [TileFace] -> Vertex -> VertexMap [TileFace]
insertf VertexMap [TileFace]
vmap Vertex
v = (Maybe [TileFace] -> Maybe [TileFace])
-> Vertex -> VertexMap [TileFace] -> VertexMap [TileFace]
forall a. (Maybe a -> Maybe a) -> Vertex -> IntMap a -> IntMap a
VMap.alter Maybe [TileFace] -> Maybe [TileFace]
consf Vertex
v VertexMap [TileFace]
vmap
   consf :: Maybe [TileFace] -> Maybe [TileFace]
consf Maybe [TileFace]
Nothing = [TileFace] -> Maybe [TileFace]
forall a. a -> Maybe a
Just [TileFace
f]
   consf (Just [TileFace]
fs) = [TileFace] -> Maybe [TileFace]
forall a. a -> Maybe a
Just (TileFace
fTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:[TileFace]
fs)
   
-- |facesAtBV bd v - returns the faces found at v (which must be a boundary vertex)
facesAtBV:: BoundaryState -> Vertex -> [TileFace]
facesAtBV :: BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v = case Vertex -> VertexMap [TileFace] -> Maybe [TileFace]
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd) of
  Just [TileFace]
fcs -> [TileFace]
fcs
  Maybe [TileFace]
Nothing -> String -> [TileFace]
forall a. HasCallStack => String -> a
error (String -> [TileFace]) -> String -> [TileFace]
forall a b. (a -> b) -> a -> b
$ String
"facesAtBV: Not a boundary vertex? No faces found at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |return a list of faces which have a boundary vertex from a BoundaryState
boundaryFaces :: BoundaryState -> [TileFace]
boundaryFaces :: BoundaryState -> [TileFace]
boundaryFaces BoundaryState
bd = [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a]
nub ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (Vertex -> [TileFace]) -> [Vertex] -> [TileFace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd) [Vertex]
bvs where
    bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst ([(Vertex, Vertex)] -> [Vertex]) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
-- boundaryFaces = nub . concat . VMap.elems . bvFacesMap 
-- relies on the map containing no extra info for non boundary vertices



-- |An Update is either safe or unsafe.
-- A safe update has a new face involving 3 existing vertices.
-- An unsafe update has a makeFace function to create the new face when given a fresh third vertex.
data Update = SafeUpdate TileFace 
            | UnsafeUpdate (Vertex -> TileFace)

-- | 0 is used as a dummy variable to show unsafe updates (to display the function explicitly)
instance Show Update where
    show :: Update -> String
show (SafeUpdate TileFace
f) = String
"SafeUpdate (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (UnsafeUpdate Vertex -> TileFace
mf) = String
"UnsafeUpdate (\0 -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show (Vertex -> TileFace
mf Vertex
0)String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    
-- |UpdateMap: partial map associating updates with (some) boundary directed edges.
-- (Any boundary directed edge will have the opposite direction in some face.)
type UpdateMap = Map.Map Dedge Update

-- |ForceState: The force state records information between executing single face updates during forcing
-- (a BoundaryState and an UpdateMap).
data ForceState = ForceState 
                   { ForceState -> BoundaryState
boundaryState:: BoundaryState
                   , ForceState -> UpdateMap
updateMap:: UpdateMap 
                   }

{-|UpdateGenerator abbreviates the type of functions which capture one or more of the forcing rules.
They produce a (Try) UpdateMap when given a BoundaryState and a focus list of particular directed boundary edges.  
Each forcing rule has a particular UpdateGenerator,
but they can also be combined (e.g in sequence - allUGenerator or otherwise - defaultAllUGenerator).
-}
type UpdateGenerator = BoundaryState -> [Dedge] -> Try UpdateMap



-- | Forcible class has operations to (indirectly) implement forcing and single step forcing
-- (tryForceWith, tryStepForceWith) for any Forcible. The class operations are more general to allow for other
-- force related operations to be generalised for use on any Forcible.
-- Both tryForceWith and tryStepForceWith are implemented using tryFSOpWith, and
-- tryAddHalfKite and tryAddHalfDart are implemented using tryChangeBoundaryWith.
--
-- To improve performance of a sequence of force related operations, express each as a
-- ForceState -> Try ForceState, then use (<=<) or (>=>) to combine and pass to tryFSOpWith.
-- This ensures there are no unnecessary conversions between steps.
class Forcible a where
    -- | tryFSOpWith (try ForseState Operation with) when given an update generator, generalises a (try) ForceState operation to a (try) Forcible operation.
    -- The update generator is only used to initialise a ForceState when there is not one
    -- already available (i.e not used when the Forcible is a ForceState)
    tryFSOpWith :: UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
    -- | tryInitFSWith (try initialising a ForceState with) when given an update generator tries to create an initial ForceState (ready for forcing) from a Forcible.
    -- Again, the update generator is not used when the instance is a ForceState.
    tryInitFSWith :: UpdateGenerator -> a -> Try ForceState
    -- | tryChangeBoundaryWith when given an update generator, converts a (try) BoundaryState changing operation to a (try) Forcible operation.
    -- The update generator is only used when the instance is a ForceState (to revise the update map in the result).
    tryChangeBoundaryWith :: UpdateGenerator -> (BoundaryState -> Try BoundaryChange) -> a -> Try a
{-
    -- | construct or recover the BoundaryState from a Forcible
    getBoundaryState :: a -> BoundaryState
-}

-- |ForceStates are Forcible
instance Forcible ForceState where
    tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState) -> ForceState -> Try ForceState
tryFSOpWith UpdateGenerator
_ = (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a. a -> a
id  -- update generator not used
    tryInitFSWith :: UpdateGenerator -> ForceState -> Try ForceState
tryInitFSWith UpdateGenerator
_  = ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return  -- update generator not used
    tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> ForceState
-> Try ForceState
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f ForceState
fs = do
        BoundaryChange
bdC <- BoundaryState -> Try BoundaryChange
f (ForceState -> BoundaryState
boundaryState ForceState
fs)
        UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
ugen BoundaryChange
bdC ForceState
fs
--    getBoundaryState = boundaryState
    
-- | BoundaryStates are Forcible    
instance Forcible BoundaryState where
    tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState)
-> BoundaryState
-> Try BoundaryState
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f BoundaryState
bd = do
        ForceState
fs <- UpdateGenerator -> BoundaryState -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
ugen BoundaryState
bd
        ForceState
fs' <- ForceState -> Try ForceState
f ForceState
fs
        BoundaryState -> Try BoundaryState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoundaryState -> Try BoundaryState)
-> BoundaryState -> Try BoundaryState
forall a b. (a -> b) -> a -> b
$ ForceState -> BoundaryState
boundaryState ForceState
fs'
    tryInitFSWith :: UpdateGenerator -> BoundaryState -> Try ForceState
tryInitFSWith UpdateGenerator
ugen BoundaryState
bd = do
        UpdateMap
umap <- UpdateGenerator
ugen BoundaryState
bd (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd)
        ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState { boundaryState :: BoundaryState
boundaryState = BoundaryState
bd , updateMap :: UpdateMap
updateMap = UpdateMap
umap }
    tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> BoundaryState
-> Try BoundaryState
tryChangeBoundaryWith UpdateGenerator
_ BoundaryState -> Try BoundaryChange
f BoundaryState
bd = do -- update generator not used
        BoundaryChange
bdC <- BoundaryState -> Try BoundaryChange
f BoundaryState
bd
        BoundaryState -> Try BoundaryState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoundaryState -> Try BoundaryState)
-> BoundaryState -> Try BoundaryState
forall a b. (a -> b) -> a -> b
$ BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdC
--    getBoundaryState = id

-- | Tgraphs are Forcible    
instance Forcible Tgraph where
    tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState) -> Tgraph -> Try Tgraph
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f Tgraph
g = BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> Try BoundaryState -> Try Tgraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateGenerator
-> (ForceState -> Try ForceState)
-> BoundaryState
-> Try BoundaryState
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
    tryInitFSWith :: UpdateGenerator -> Tgraph -> Try ForceState
tryInitFSWith UpdateGenerator
ugen Tgraph
g = UpdateGenerator -> BoundaryState -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
ugen (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
    tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> Tgraph -> Try Tgraph
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f Tgraph
g = -- update generator not used
        BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> Try BoundaryState -> Try Tgraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> BoundaryState
-> Try BoundaryState
forall a.
Forcible a =>
UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
--    getBoundaryState = makeBoundaryState


-- | try forcing using a given UpdateGenerator.
--  tryForceWith uGen fs - recursively does updates using uGen until there are no more updates.
--  It produces Left report if it encounters a Forcible representing a stuck/incorrect Tgraph.
tryForceWith :: Forcible a => UpdateGenerator -> a -> Try a
tryForceWith :: forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
ugen = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen (UpdateGenerator -> ForceState -> Try ForceState
tryForceStateWith UpdateGenerator
ugen) where
--    tryForceStateWith :: UpdateGenerator -> ForceState -> Try ForceState
    tryForceStateWith :: UpdateGenerator -> ForceState -> Try ForceState
tryForceStateWith UpdateGenerator
uGen = ForceState -> Try ForceState
retry where
      retry :: ForceState -> Try ForceState
retry ForceState
fs = case UpdateMap -> Maybe Update
findSafeUpdate (ForceState -> UpdateMap
updateMap ForceState
fs) of
                 Just Update
u -> do BoundaryChange
bdChange <- BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate (ForceState -> BoundaryState
boundaryState ForceState
fs) Update
u
                              ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdChange ForceState
fs
                              ForceState -> Try ForceState
retry ForceState
fs'
                 Maybe Update
_  -> do Maybe BoundaryChange
maybeBdC <- ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs
                          case Maybe BoundaryChange
maybeBdC of
                            Maybe BoundaryChange
Nothing  -> ForceState -> Try ForceState
forall a b. b -> Either a b
Right ForceState
fs -- no more updates
                         -- Nothing -> tryFinalStuckCheck fs  -- No Longer used
                            Just BoundaryChange
bdC -> do ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdC ForceState
fs
                                           ForceState -> Try ForceState
retry ForceState
fs'
    
-- | try a given number of force steps using a given UpdateGenerator.
tryStepForceWith :: Forcible a => UpdateGenerator -> Int -> a -> Try a
tryStepForceWith :: forall a. Forcible a => UpdateGenerator -> Vertex -> a -> Try a
tryStepForceWith UpdateGenerator
ugen Vertex
n = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen ((ForceState -> Try ForceState) -> a -> Try a)
-> (ForceState -> Try ForceState) -> a -> Try a
forall a b. (a -> b) -> a -> b
$ Vertex -> ForceState -> Try ForceState
forall {t}. (Eq t, Num t) => t -> ForceState -> Try ForceState
count Vertex
n where
      count :: t -> ForceState -> Try ForceState
count t
0 ForceState
fs = ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs
      count t
m ForceState
fs = do Maybe (ForceState, BoundaryChange)
result <- UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
ugen ForceState
fs
                      case Maybe (ForceState, BoundaryChange)
result of
                       Maybe (ForceState, BoundaryChange)
Nothing -> ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs
                       Just (ForceState
fs', BoundaryChange
_) ->  t -> ForceState -> Try ForceState
count (t
mt -> t -> t
forall a. Num a => a -> a -> a
-t
1) ForceState
fs' 
{-
tryStepForceWith ugen n = tryFSOpWith ugen $ tryStepForceStateWith ugen n where
--    tryStepForceStateWith :: UpdateGenerator -> Int -> ForceState -> Try ForceState
    tryStepForceStateWith updateGen = count where
      count 0 fs = return fs
      count m fs = do result <- tryOneStepWith updateGen fs
                      case result of
                       Nothing -> return fs
                       Just (fs', _) ->  count (m-1) fs' 
 -}
   
-- |A version of tryFSOpWith using defaultAllUGen representing all 10 rules for updates.
tryFSOp :: Forcible a => (ForceState -> Try ForceState) -> a -> Try a
tryFSOp :: forall a.
Forcible a =>
(ForceState -> Try ForceState) -> a -> Try a
tryFSOp = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
defaultAllUGen

-- |A version of the main force function using defaultAllUGen representing all 10 rules for updates.
-- This returns Left report on discovering a stuck Tgraph and Right a (with a the resulting forcible) otherwise.
tryForce:: Forcible a => a -> Try a
tryForce :: forall a. Forcible a => a -> Try a
tryForce = UpdateGenerator -> a -> Try a
forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
defaultAllUGen

-- |The main force function using defaultAllUGen representing all 10 rules for updates.
-- This raises an error on discovering a stuck/incorrect Forcible.
force:: Forcible a => a -> a
force :: forall a. Forcible a => a -> a
force = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Try a
forall a. Forcible a => a -> Try a
tryForce

-- |special case of forcing only half tiles to whole tiles
wholeTiles:: Forcible a => a -> a
wholeTiles :: forall a. Forcible a => a -> a
wholeTiles = UpdateGenerator -> a -> a
forall a. Forcible a => UpdateGenerator -> a -> a
forceWith UpdateGenerator
wholeTileUpdates 

-- | forceWith ugen: force using the given UpdateGenerator
forceWith:: Forcible a => UpdateGenerator -> a -> a
forceWith :: forall a. Forcible a => UpdateGenerator -> a -> a
forceWith UpdateGenerator
ugen = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateGenerator -> a -> Try a
forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
ugen

-- | try to initialize a force state with the default UpdateGenerator.
-- Returns a Left report if it finds a stuck forcible.
tryInitFS :: Forcible a => a -> Try ForceState
tryInitFS :: forall a. Forcible a => a -> Try ForceState
tryInitFS = UpdateGenerator -> a -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
defaultAllUGen

-- | initialize a force state with the default UpdateGenerator.
-- Raises aan error if it finds a stuck forcible.
initFS :: Forcible a => a -> ForceState
initFS :: forall a. Forcible a => a -> ForceState
initFS = Try ForceState -> ForceState
forall a. Try a -> a
runTry (Try ForceState -> ForceState)
-> (a -> Try ForceState) -> a -> ForceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Try ForceState
forall a. Forcible a => a -> Try ForceState
tryInitFS

-- |tryStepForce n a - produces a (Right) intermediate Forcible after n steps (n face additions) starting from Forcible a.
-- or a Left report if it encounters a stuck/incorrect Forcible within n steps.
-- If forcing finishes successfully in n or fewer steps, it will return that final Forcible. 
tryStepForce :: Forcible a => Int -> a -> Try a 
tryStepForce :: forall a. Forcible a => Vertex -> a -> Try a
tryStepForce = UpdateGenerator -> Vertex -> a -> Try a
forall a. Forcible a => UpdateGenerator -> Vertex -> a -> Try a
tryStepForceWith UpdateGenerator
defaultAllUGen-- Was called tryStepForceFrom

-- |stepForce  n a - produces an intermediate intermediate Forcible after n steps (n face additions) starting from Forcible a.
-- It raises an error if it encounters a stuck/incorrect Tgraph/Forcible within n steps.
-- If forcing finishes successfully in n or fewer steps, it will return that final Forcible. 
stepForce :: Forcible a => Int -> a ->  a
stepForce :: forall a. Forcible a => Vertex -> a -> a
stepForce Vertex
n = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> a -> Try a
forall a. Forcible a => Vertex -> a -> Try a
tryStepForce Vertex
n

-- |specialises tryChangeBoundaryWith to the default update generator.
tryChangeBoundary:: Forcible a => (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary :: forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary = UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundaryWith UpdateGenerator
defaultAllUGen



-- |addHalfKite is for adding a single half kite on a chosen boundary Dedge of a Forcible.
-- The Dedge must be a boundary edge but the direction is not important as
-- the correct direction is automatically calculated.
-- It will raise an error if the edge is a dart join or if a conflict (stuck graph) is detected
-- or if the edge is not a boundary edge.
addHalfKite :: Forcible a => Dedge -> a -> a
addHalfKite :: forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfKite (Vertex, Vertex)
e  = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> a -> Try a
forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfKite (Vertex, Vertex)
e

-- |tryAddHalfKite is a version of addHalfKite which returns a Try
-- with a Left report if it finds a stuck/incorrect graph, or 
-- if the edge is a dart join, or
-- if the edge is not a boundary edge.   
tryAddHalfKite :: Forcible a => Dedge -> a -> Try a
tryAddHalfKite :: forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfKite = (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary ((BoundaryState -> Try BoundaryChange) -> a -> Try a)
-> ((Vertex, Vertex) -> BoundaryState -> Try BoundaryChange)
-> (Vertex, Vertex)
-> a
-> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfKiteBoundary where
-- |tryAddHalfKiteBoundary implements tryAddHalfKite as a BoundaryState change
-- tryAddHalfKiteBoundary :: Dedge -> BoundaryState -> Try BoundaryChange
    tryAddHalfKiteBoundary :: (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfKiteBoundary (Vertex, Vertex)
e BoundaryState
bd = 
      do (Vertex, Vertex)
de <- case [(Vertex, Vertex)
e, (Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e] [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd of
                 [(Vertex, Vertex)
de] -> (Vertex, Vertex) -> Either String (Vertex, Vertex)
forall a b. b -> Either a b
Right (Vertex, Vertex)
de
                 [(Vertex, Vertex)]
_ -> String -> Either String (Vertex, Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Vertex, Vertex))
-> String -> Either String (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryAddHalfKiteBoundary:  on non-boundary edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
         let (TileFace
fc,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
de
         let tryU :: Try Update
tryU | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Long = UChecker
addKiteLongE BoundaryState
bd TileFace
fc
                  | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Short = UChecker
addKiteShortE BoundaryState
bd TileFace
fc
                  | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Join Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc = UChecker
completeHalf BoundaryState
bd TileFace
fc
                  | Bool
otherwise = String -> Try Update
forall a b. a -> Either a b
Left String
"tryAddHalfKiteBoundary: applied to dart join (not possible).\n"
         Update
u <- Try Update
tryU
         BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd Update
u

-- |addHalfDart is for adding a single half dart on a chosen boundary Dedge of a Forcible.
-- The Dedge must be a boundary edge but the direction is not important as
-- the correct direction is automatically calculated.
-- It will raise an error if the edge is a dart short edge or kite join
-- or if a conflict (stuck graph) is detected or if
-- the edge is not a boundary edge.
addHalfDart :: Forcible a => Dedge -> a -> a
addHalfDart :: forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex, Vertex)
e = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> a -> Try a
forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfDart (Vertex, Vertex)
e
  
-- |tryAddHalfDart is a version of addHalfDart which returns a Try
-- with a Left report if it finds a stuck/incorrect graph, or
-- if the edge is a dart short edge or kite join, or
-- if the edge is not a boundary edge.
tryAddHalfDart :: Forcible a => Dedge -> a -> Try a
tryAddHalfDart :: forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfDart = (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary ((BoundaryState -> Try BoundaryChange) -> a -> Try a)
-> ((Vertex, Vertex) -> BoundaryState -> Try BoundaryChange)
-> (Vertex, Vertex)
-> a
-> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfDartBoundary where
-- |tryAddHalfDartBoundary implements tryAddHalfDart as a BoundaryState change
-- tryAddHalfDartBoundary :: Dedge -> BoundaryState -> Try BoundaryChange
    tryAddHalfDartBoundary :: (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfDartBoundary (Vertex, Vertex)
e BoundaryState
bd = 
      do (Vertex, Vertex)
de <- case [(Vertex, Vertex)
e, (Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e] [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd of
                [(Vertex, Vertex)
de] -> (Vertex, Vertex) -> Either String (Vertex, Vertex)
forall a b. b -> Either a b
Right (Vertex, Vertex)
de
                [(Vertex, Vertex)]
_ -> String -> Either String (Vertex, Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Vertex, Vertex))
-> String -> Either String (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryAddHalfDartBoundary:  on non-boundary edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
         let (TileFace
fc,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
de
         let tryU :: Try Update
tryU | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Long = UChecker
addDartLongE BoundaryState
bd TileFace
fc
                  | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Short Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc = UChecker
addDartShortE BoundaryState
bd TileFace
fc
                  | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Join Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc = UChecker
completeHalf BoundaryState
bd TileFace
fc
                  | Bool
otherwise = String -> Try Update
forall a b. a -> Either a b
Left String
"tryAddHalfDartBoundary: applied to short edge of dart or to kite join (not possible).\n"
         Update
u <- Try Update
tryU
         BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd Update
u


-- |tryOneStepWith uGen fs does one force step.
-- It returns a (Try maybe) with a new force sate paired with the boundary change for debugging purposes.
-- It uses uGen to revise updates in the final ForceState. 
-- It produces Left report for a stuck/incorrect graph.
-- A result of Right Nothing indicates forcing has finished and there are no more updates.
tryOneStepWith :: UpdateGenerator -> ForceState -> Try (Maybe (ForceState,BoundaryChange))
tryOneStepWith :: UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
uGen ForceState
fs = 
      case UpdateMap -> Maybe Update
findSafeUpdate (ForceState -> UpdateMap
updateMap ForceState
fs) of
      Just Update
u -> do BoundaryChange
bdChange <- BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate (ForceState -> BoundaryState
boundaryState ForceState
fs) Update
u
                   ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdChange ForceState
fs
                   Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ForceState, BoundaryChange)
 -> Try (Maybe (ForceState, BoundaryChange)))
-> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a b. (a -> b) -> a -> b
$ (ForceState, BoundaryChange) -> Maybe (ForceState, BoundaryChange)
forall a. a -> Maybe a
Just (ForceState
fs',BoundaryChange
bdChange)
      Maybe Update
_  -> do Maybe BoundaryChange
maybeBdC <- ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs
               case Maybe BoundaryChange
maybeBdC of
                Just BoundaryChange
bdC -> do ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdC ForceState
fs
                               Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ForceState, BoundaryChange)
 -> Try (Maybe (ForceState, BoundaryChange)))
-> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a b. (a -> b) -> a -> b
$ (ForceState, BoundaryChange) -> Maybe (ForceState, BoundaryChange)
forall a. a -> Maybe a
Just (ForceState
fs',BoundaryChange
bdC)
                Maybe BoundaryChange
Nothing  -> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForceState, BoundaryChange)
forall a. Maybe a
Nothing           -- no more updates

-- |tryOneStepF is a special case of tryOneStepWith only used for debugging
tryOneStepF :: ForceState -> Try (Maybe (ForceState,BoundaryChange))
tryOneStepF :: ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepF = UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
defaultAllUGen


{-| BoundaryChange records the new boundary state after completing an update (by either trySafeUpdate or tryUnsafeUpdate)
     along with a list of directed edges which are no longer on the boundary,
     plus a list of boundary edges revised (and requiring updates to be recalculated).
     See affectedBoundary.
-}
data BoundaryChange = BoundaryChange 
                       { BoundaryChange -> BoundaryState
newBoundaryState:: BoundaryState -- ^ resulting boundary state
                       , BoundaryChange -> [(Vertex, Vertex)]
removedEdges:: [Dedge] -- ^ edges no longer on the boundary
                       , BoundaryChange -> [(Vertex, Vertex)]
revisedEdges :: [Dedge]  -- ^ boundary edges requiring new update calculations
                       , BoundaryChange -> TileFace
newFace :: TileFace -- ^ face added in the change
                       } deriving (Vertex -> BoundaryChange -> ShowS
[BoundaryChange] -> ShowS
BoundaryChange -> String
(Vertex -> BoundaryChange -> ShowS)
-> (BoundaryChange -> String)
-> ([BoundaryChange] -> ShowS)
-> Show BoundaryChange
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> BoundaryChange -> ShowS
showsPrec :: Vertex -> BoundaryChange -> ShowS
$cshow :: BoundaryChange -> String
show :: BoundaryChange -> String
$cshowList :: [BoundaryChange] -> ShowS
showList :: [BoundaryChange] -> ShowS
Show)

{-| Given a BoundaryState with a list of one new boundary edge or
     two adjacent new boundary edges (or exceptionally no new boundary edges) to be added,
     it extends the list with adjacent boundary edges (to produce 3 or 4 or none).
     (Used to calculate revisedEdges in a BoundaryChange)
     (When a face is fitted in to a hole with 3 sides there is no new boundary.)
-}
affectedBoundary :: BoundaryState -> [Dedge] -> [Dedge]
affectedBoundary :: BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b)] = [(Vertex
x,Vertex
a),(Vertex
a,Vertex
b),(Vertex
b,Vertex
y)] where
           bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
           (Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
           (Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
bVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c = [(Vertex
x,Vertex
a),(Vertex
a,Vertex
b),(Vertex
c,Vertex
d),(Vertex
d,Vertex
y)] where
           bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
           (Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
           (Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
d)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
aVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
d = [(Vertex
x,Vertex
c),(Vertex
c,Vertex
d),(Vertex
a,Vertex
b),(Vertex
b,Vertex
y)] where
           bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
           (Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
           (Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
_ [] = []
affectedBoundary BoundaryState
_ [(Vertex, Vertex)]
edges = String -> [(Vertex, Vertex)]
forall a. HasCallStack => String -> a
error (String -> [(Vertex, Vertex)]) -> String -> [(Vertex, Vertex)]
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: unexpected new boundary edges " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex, Vertex)]
edges String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

{-| mustFind is an auxiliary function used to search with definite result.
mustFind p ls err returns the first item in ls satisfying predicate p and returns
err argument when none found (in finite cases).    
-}
mustFind :: Foldable t => (p -> Bool) -> t p -> p -> p
mustFind :: forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind p -> Bool
p t p
ls p
err
  = p -> (p -> p) -> Maybe p -> p
forall b a. b -> (a -> b) -> Maybe a -> b
maybe p
err p -> p
forall a. a -> a
id ((p -> Bool) -> t p -> Maybe p
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find p -> Bool
p t p
ls)

-- |tryReviseUpdates uGen bdChange: revises the UpdateMap after boundary change (bdChange)
-- using uGen to calculate new updates.
tryReviseUpdates:: UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates :: UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates UpdateGenerator
uGen BoundaryChange
bdChange UpdateMap
umap = 
  do let umap' :: UpdateMap
umap' = ((Vertex, Vertex) -> UpdateMap -> UpdateMap)
-> UpdateMap -> [(Vertex, Vertex)] -> UpdateMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Vertex, Vertex) -> UpdateMap -> UpdateMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete UpdateMap
umap (BoundaryChange -> [(Vertex, Vertex)]
removedEdges BoundaryChange
bdChange)
     UpdateMap
umap'' <- UpdateGenerator
uGen (BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdChange) (BoundaryChange -> [(Vertex, Vertex)]
revisedEdges BoundaryChange
bdChange) 
     UpdateMap -> Try UpdateMap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdateMap -> UpdateMap -> UpdateMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union UpdateMap
umap'' UpdateMap
umap')

-- |tryReviseFSWith ugen bdC fs tries to revise fs after a boundary change (bdC) by calculating
-- the revised updates with ugen (and using the new boundary state in bdC).
tryReviseFSWith :: UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith :: UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
ugen BoundaryChange
bdC ForceState
fs =
    do UpdateMap
umap <- UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates UpdateGenerator
ugen BoundaryChange
bdC (ForceState -> UpdateMap
updateMap ForceState
fs)
       ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState{ boundaryState :: BoundaryState
boundaryState = BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdC, updateMap :: UpdateMap
updateMap = UpdateMap
umap}


-- |finds the first safe update - Nothing if there are none (ordering is directed edge key ordering)
findSafeUpdate:: UpdateMap -> Maybe Update 
findSafeUpdate :: UpdateMap -> Maybe Update
findSafeUpdate UpdateMap
umap = (Update -> Bool) -> [Update] -> Maybe Update
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Update -> Bool
isSafeUpdate (UpdateMap -> [Update]
forall k a. Map k a -> [a]
Map.elems UpdateMap
umap) where
  isSafeUpdate :: Update -> Bool
isSafeUpdate (SafeUpdate TileFace
_ ) = Bool
True
  isSafeUpdate (UnsafeUpdate Vertex -> TileFace
_ ) = Bool
False

{-| tryUnsafes: Should only be used when there are no Safe updates in the UpdateMap.
   tryUnsafes works through the unsafe updates in (directed edge) key order and
   completes the first unsafe update that is not blocked (by a touching vertex), returning Right (Just bdC)
   where bdC is the resulting boundary change (if there is one).
   It returns Right Nothing if there are no unsafe updates but
   Left report if there are unsafes but all unsafes are blocked, where report describes the problem.
-}
tryUnsafes:: ForceState -> Try (Maybe BoundaryChange)
tryUnsafes :: ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs = Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked Vertex
0 ([Update] -> Try (Maybe BoundaryChange))
-> [Update] -> Try (Maybe BoundaryChange)
forall a b. (a -> b) -> a -> b
$ UpdateMap -> [Update]
forall k a. Map k a -> [a]
Map.elems (UpdateMap -> [Update]) -> UpdateMap -> [Update]
forall a b. (a -> b) -> a -> b
$ ForceState -> UpdateMap
updateMap ForceState
fs where
  bd :: BoundaryState
bd = ForceState -> BoundaryState
boundaryState ForceState
fs
  -- the integer records how many blocked cases have been found so far
  checkBlocked:: Int -> [Update]  -> Try (Maybe BoundaryChange)
  checkBlocked :: Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked Vertex
0 [] = Maybe BoundaryChange -> Try (Maybe BoundaryChange)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BoundaryChange
forall a. Maybe a
Nothing
  checkBlocked Vertex
n [] = String -> Try (Maybe BoundaryChange)
forall a b. a -> Either a b
Left (String -> Try (Maybe BoundaryChange))
-> String -> Try (Maybe BoundaryChange)
forall a b. (a -> b) -> a -> b
$ String
"tryUnsafes: There are " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
nString -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" unsafe updates but ALL unsafe updates are blocked (by touching vertices)\n"
                             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"This should not happen! However it may arise when accuracy limits are reached on very large Tgraphs.\n"
                             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Total number of faces is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  checkBlocked Vertex
n (Update
u: [Update]
more) = case BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
bd Update
u of
                               Maybe BoundaryChange
Nothing -> Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked (Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) [Update]
more
                               Maybe BoundaryChange
other -> Maybe BoundaryChange -> Try (Maybe BoundaryChange)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BoundaryChange
other

{-| checkUnsafeUpdate bd u, calculates the resulting boundary change for an unsafe update (u) with a new vertex
     (raising an error if u is a safe update).
     It performs a touching vertex check with the new vertex
     returning Nothing if there is a touching vertex (blocked case).
     Otherwise it returns Just bdc with bdc a boundary change.
    [Note: Try is not used as a conflict cannot be found in the unsafe case, and blocking is only a problem
    when all unsafe updates are blocked (and there is at least one) - see tryUnsafes]
-}
checkUnsafeUpdate:: BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate :: BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
_  (SafeUpdate TileFace
_) = String -> Maybe BoundaryChange
forall a. HasCallStack => String -> a
error  String
"checkUnsafeUpdate: applied to safe update.\n"
checkUnsafeUpdate BoundaryState
bd (UnsafeUpdate Vertex -> TileFace
makeFace) = 
   let v :: Vertex
v = BoundaryState -> Vertex
nextVertex BoundaryState
bd       
       newface :: TileFace
newface = Vertex -> TileFace
makeFace Vertex
v
       oldVPoints :: VertexMap (Point V2 Double)
oldVPoints = BoundaryState -> VertexMap (Point V2 Double)
bvLocMap BoundaryState
bd
       newVPoints :: VertexMap (Point V2 Double)
newVPoints = TileFace
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
addVPoint TileFace
newface VertexMap (Point V2 Double)
oldVPoints
       vPosition :: Point V2 Double
vPosition = VertexMap (Point V2 Double)
newVPoints VertexMap (Point V2 Double) -> Vertex -> Point V2 Double
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
v -- Just vPosition = VMap.lookup v newVPoints
       fDedges :: [(Vertex, Vertex)]
fDedges = TileFace -> [(Vertex, Vertex)]
faceDedges TileFace
newface
       matchedDedges :: [(Vertex, Vertex)]
matchedDedges = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Vertex
x,Vertex
y) -> Vertex
x Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
v Bool -> Bool -> Bool
&& Vertex
y Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
v) [(Vertex, Vertex)]
fDedges -- singleton
       newDedges :: [(Vertex, Vertex)]
newDedges = ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
reverseD ([(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges) -- two edges
       resultBd :: BoundaryState
resultBd = BoundaryState
                    { boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
newDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. [a] -> [a] -> [a]
++ (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
                    , bvFacesMap :: VertexMap [TileFace]
bvFacesMap = TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
newface (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd)
                    , bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
newVPoints
                    , allFaces :: [TileFace]
allFaces = TileFace
newfaceTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:BoundaryState -> [TileFace]
allFaces BoundaryState
bd
                    , nextVertex :: Vertex
nextVertex = Vertex
vVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1
                    }
       bdChange :: BoundaryChange
bdChange = BoundaryChange 
                    { newBoundaryState :: BoundaryState
newBoundaryState = BoundaryState
resultBd
                    , removedEdges :: [(Vertex, Vertex)]
removedEdges = [(Vertex, Vertex)]
matchedDedges
                    , revisedEdges :: [(Vertex, Vertex)]
revisedEdges = BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
resultBd [(Vertex, Vertex)]
newDedges
                    , newFace :: TileFace
newFace = TileFace
newface
                    }
   in if Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck Point V2 Double
vPosition VertexMap (Point V2 Double)
oldVPoints -- true if new vertex is blocked because it touches the boundary elsewhere
      then Maybe BoundaryChange
forall a. Maybe a
Nothing -- don't proceed when v is a touching vertex
      else BoundaryChange -> Maybe BoundaryChange
forall a. a -> Maybe a
Just BoundaryChange
bdChange 

{-| trySafeUpdate bd u adds a new face by completing a safe update u on BoundaryState bd
    (raising an error if u is an unsafe update).
     It returns a Right BoundaryChange (containing a new BoundaryState, removed boundary edges and
     revised boundary edge list), unless a stuck/incorrect graph is found.
     It checks that the new face is not in conflict with existing faces,
     producing (Left report) if there is a conflict.
    It should cater for the exceptional case where the update removes 3 boundary edges
    in a triangle (and removes 3 boundary vertices), closing a hole.
-}
trySafeUpdate:: BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate :: BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate BoundaryState
_  (UnsafeUpdate Vertex -> TileFace
_) = String -> Try BoundaryChange
forall a. HasCallStack => String -> a
error String
"trySafeUpdate: applied to non-safe update.\n"
trySafeUpdate BoundaryState
bd (SafeUpdate TileFace
newface) = 
   let fDedges :: [(Vertex, Vertex)]
fDedges = TileFace -> [(Vertex, Vertex)]
faceDedges TileFace
newface
       matchedDedges :: [(Vertex, Vertex)]
matchedDedges = [(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd -- list of 2 or 3
       removedBVs :: [Vertex]
removedBVs = [(Vertex, Vertex)] -> [Vertex]
commonVs [(Vertex, Vertex)]
matchedDedges -- usually 1 vertex no longer on boundary (exceptionally 3)
       newDedges :: [(Vertex, Vertex)]
newDedges = ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
reverseD ([(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges) -- one or none
       nbrFaces :: [TileFace]
nbrFaces = [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a]
nub ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (Vertex -> [TileFace]) -> [Vertex] -> [TileFace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd) [Vertex]
removedBVs
       resultBd :: BoundaryState
resultBd = BoundaryState 
                   { boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
newDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. [a] -> [a] -> [a]
++ (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
                   , bvFacesMap :: VertexMap [TileFace]
bvFacesMap = (Vertex -> VertexMap [TileFace] -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [Vertex] -> VertexMap [TileFace]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vertex -> VertexMap [TileFace] -> VertexMap [TileFace]
forall a. Vertex -> IntMap a -> IntMap a
VMap.delete (TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
newface (VertexMap [TileFace] -> VertexMap [TileFace])
-> VertexMap [TileFace] -> VertexMap [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd) [Vertex]
removedBVs
--                   , bvFacesMap = changeVFMap newface (bvFacesMap bd)
                   , allFaces :: [TileFace]
allFaces = TileFace
newfaceTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:BoundaryState -> [TileFace]
allFaces BoundaryState
bd
                   , bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = (Vertex
 -> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double)
-> [Vertex]
-> VertexMap (Point V2 Double)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vertex
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. Vertex -> IntMap a -> IntMap a
VMap.delete (BoundaryState -> VertexMap (Point V2 Double)
bvLocMap BoundaryState
bd) [Vertex]
removedBVs
                               --remove vertex/vertices no longer on boundary
                   , nextVertex :: Vertex
nextVertex = BoundaryState -> Vertex
nextVertex BoundaryState
bd
                   }
       bdChange :: BoundaryChange
bdChange = BoundaryChange 
                   { newBoundaryState :: BoundaryState
newBoundaryState = BoundaryState
resultBd
                   , removedEdges :: [(Vertex, Vertex)]
removedEdges = [(Vertex, Vertex)]
matchedDedges
                   , revisedEdges :: [(Vertex, Vertex)]
revisedEdges = BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
resultBd [(Vertex, Vertex)]
newDedges
                   , newFace :: TileFace
newFace = TileFace
newface
                   }
   in if TileFace -> [TileFace] -> Bool
noNewConflict TileFace
newface [TileFace]
nbrFaces 
      then BoundaryChange -> Try BoundaryChange
forall a b. b -> Either a b
Right BoundaryChange
bdChange 
      else String -> Try BoundaryChange
forall a b. a -> Either a b
Left (String -> Try BoundaryChange) -> String -> Try BoundaryChange
forall a b. (a -> b) -> a -> b
$ String
"trySafeUpdate:(incorrect tiling)\nConflicting new face  "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
newface
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith neighbouring faces\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show [TileFace]
nbrFaces
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

                 
-- | given 2 consecutive directed edges (not necessarily in the right order),
-- this returns the common vertex (as a singleton list).
-- Exceptionally it may be given 3 consecutive directed edges forming a triangle
-- and returns the 3 vertices of the triangle.
-- It raises an error if the argument is not one of these 2 cases.
commonVs :: [Dedge] -> [Vertex]
commonVs :: [(Vertex, Vertex)] -> [Vertex]
commonVs [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
bVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c = [Vertex
b] 
                       | Vertex
dVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a = [Vertex
a]
                       | Bool
otherwise = String -> [Vertex]
forall a. HasCallStack => String -> a
error (String -> [Vertex]) -> String -> [Vertex]
forall a b. (a -> b) -> a -> b
$ String
"commonVs: 2 directed edges not consecutive: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
commonVs [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d),(Vertex
e,Vertex
f)] | [Vertex] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a]
nub [Vertex
a,Vertex
b,Vertex
c,Vertex
d,Vertex
e,Vertex
f]) Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
3 = [Vertex
a,Vertex
c,Vertex
e] 
commonVs [(Vertex, Vertex)]
es = String -> [Vertex]
forall a. HasCallStack => String -> a
error (String -> [Vertex]) -> String -> [Vertex]
forall a b. (a -> b) -> a -> b
$ String
"commonVs: unexpected argument edges (not 2 consecutive directed edges or 3 round triangle): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex, Vertex)]
es  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |tryUpdate: tries a single update (safe or unsafe),
-- producing Left report if the update creates a touching vertex in the unsafe case,
-- or if a stuck/incorrect Tgraph is discovered in the safe case.
tryUpdate:: BoundaryState -> Update -> Try BoundaryChange
tryUpdate :: BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd u :: Update
u@(SafeUpdate TileFace
_) = BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate BoundaryState
bd Update
u
tryUpdate BoundaryState
bd u :: Update
u@(UnsafeUpdate Vertex -> TileFace
_) = 
  case BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
bd Update
u of
       Just BoundaryChange
bdC -> BoundaryChange -> Try BoundaryChange
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return BoundaryChange
bdC
       Maybe BoundaryChange
Nothing ->  String -> Try BoundaryChange
forall a b. a -> Either a b
Left String
"tryUpdate: crossing boundary (touching vertices).\n"

-- |This recalibrates a BoundaryState by recalculating boundary vertex positions from scratch with locateVertices.
-- (Used at intervals in tryRecalibrateForce and recalibrateForce).
recalculateBVLocs :: BoundaryState -> BoundaryState
recalculateBVLocs :: BoundaryState -> BoundaryState
recalculateBVLocs BoundaryState
bd = BoundaryState
bd {bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
newlocs} where
    newlocs :: VertexMap (Point V2 Double)
newlocs = (Vertex -> Point V2 Double -> Bool)
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. (Vertex -> a -> Bool) -> IntMap a -> IntMap a
VMap.filterWithKey (\Vertex
k Point V2 Double
_ -> Vertex
k Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vertex]
bvs) (VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexMap (Point V2 Double)
locateVertices ([TileFace] -> VertexMap (Point V2 Double))
-> [TileFace] -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd
    bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst ([(Vertex, Vertex)] -> [Vertex]) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd

-- |A version of tryForce that recalibrates at 20,000 step intervals by recalculating boundary vertex positions from scratch.
-- This is needed to limit accumulated inaccuracies when large numbers of faces are added in forcing.
tryRecalibratingForce :: Forcible c => c -> Try c
tryRecalibratingForce :: forall a. Forcible a => a -> Try a
tryRecalibratingForce = (ForceState -> Try ForceState) -> c -> Try c
forall a.
Forcible a =>
(ForceState -> Try ForceState) -> a -> Try a
tryFSOp ForceState -> Try ForceState
recalibrating where
   recalibrating :: ForceState -> Try ForceState
recalibrating ForceState
fs = do
       ForceState
fs' <- Vertex -> ForceState -> Try ForceState
forall a. Forcible a => Vertex -> a -> Try a
tryStepForce Vertex
20000 ForceState
fs
       if UpdateMap -> Bool
forall a. Map (Vertex, Vertex) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UpdateMap -> Bool) -> UpdateMap -> Bool
forall a b. (a -> b) -> a -> b
$ ForceState -> UpdateMap
updateMap ForceState
fs'
       then ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs'
       else ForceState -> Try ForceState
recalibrating (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState
fs' {boundaryState :: BoundaryState
boundaryState = BoundaryState -> BoundaryState
recalculateBVLocs (BoundaryState -> BoundaryState) -> BoundaryState -> BoundaryState
forall a b. (a -> b) -> a -> b
$ ForceState -> BoundaryState
boundaryState ForceState
fs'}

-- |A version of force that recalibrates at 20,000 step intervals by recalculating boundary vertex positions from scratch.
-- This is needed to limit accumulation of errors when large numbers of faces are added in forcing.
recalibratingForce :: Forcible c => c -> c
recalibratingForce :: forall a. Forcible a => a -> a
recalibratingForce = Try c -> c
forall a. Try a -> a
runTry (Try c -> c) -> (c -> Try c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Try c
forall a. Forcible a => a -> Try a
tryRecalibratingForce



{-
Now unused: final stuck check
{- |
tryFinalStuckCheck was designed to check a final force state (in tryForceStateWith).
The final state is rejected as having a stuck Tgraph if any boundary vertex external angle is less than 4 (tenth turns).
This check was included in tryForceStateWith to catch examples like

  makeTgraph [LK(1,2,3),RK(4,3,2),RK(1,3,5),LK(4,6,3),RK(1,7,2),LK(4,2,8)] 

Previously forcing would not discover that the result was stuck without the check.
However a check for a false queen has been added to both allUGenerator and defaultAllUGenerator
to avoid the need for this check. 
-}
tryFinalStuckCheck:: ForceState -> Try ForceState
tryFinalStuckCheck fs =
  case find ((<4) . externalAngle bs) bvs of
     Nothing -> Right fs
     Just v -> Left $ "tryFinalStuckCheck: stuck/incorrect tiling: external angle problem found at vertex " ++ show v ++
                      "\nwith local faces:" ++ show (facesAtBV bs v) ++
                      "\nand boundary edges:" ++ show (boundary bs `intersect` (fmap reverseD $ facesDedges $ facesAtBV bs v)) ++ "\n"
  where bs = boundaryState fs
        bvs = fmap fst (boundary bs)
-}

                                    
{- $rules
Forcing rules,

1. (wholeTileUpdates) When a join edge is on the boundary - add the missing half tile to make a whole tile.    
2. (aceKiteUpdates) When a half dart has its short edge on the boundary
   add the half kite that must be on the short edge
   (this is at ace vertices but also helps with jack and deuce vertices).  
3. (queenOrKingUpdates) When a vertex is both a dart origin and a kite wing it must be a queen or king vertex.
   If there is a boundary short edge of a kite half at the vertex, 
   add another kite half sharing the short edge. 
   (This converts 1 kite to 2 and 3 kites to 4 in combination with the first rule).
4. (deuceDartUpdates) When two half kites share a short edge their oppV vertex must be a deuce vertex.
   Add any missing half darts needed to complete the vertex.
5. (jackDartUpdates) When a single dart wing is at a vertex which is recognised as an incomplete jack vertex
   and has a complete kite below the dart wing, 
   add a second dart half touching at the vertex (sharing the kite below).
   This is also known as a *largeDartBase* vertex (= new dart base next level up - see later)
6. (sunStarUpdates) When a vertex has 3 or 4 whole kite origins (= 6 or 8 half kite origins)
   it must be a sun centre. Also if a vertex has 4 whole dart origins (= 8 half dart origins)
   it must be a star centre.
   Add an appropriate half kite/dart on a boundary long edge at the vertex.
   (This will complete suns (resp. stars) along with rule 1),
7. (jackKiteUpdates) When a dart half has its wing recognised as a jack (largeDartBase) vertex
   add a missing kite half on its long edge.
8. (kingDartUpdates) When a vertex is a kite wing and also an origin for exactly 4 dart halves
   it must be a king vertex.
   Add a missing dart half (on any boundary long edge of a dart at the vertex).
9. (queenDartUpdates) If there are more than 2 kite wings at a vertex (necessarily a queen)
   add any missing half dart on a boundary kite long edge
10.(queenKiteUpdates) If there are more than 2 kite wings at a vertex (necessarily a queen)
   add any missing fourth half kite on a boundary kite short edge
-}
           
{-------------------  FORCING RULES and Generators --------------------------
7 vertex types are:
sun, queen, jack (largeDartBase), ace (fool), deuce (largeKiteCentre), king, star
-}

{-| allUGenerator combines all the 10 rule update generators.
    They are combined in sequence (keeping the rule order) after applying each to the
    supplied BoundaryState and a focus edge list. (See also defaultAllUGen).
    This version returns a Left..(fail report) for the first generator that produces a Left..(fail report).
    See $rules
-}
allUGenerator :: UpdateGenerator 
allUGenerator :: UpdateGenerator
allUGenerator BoundaryState
bd [(Vertex, Vertex)]
focus =
  do  ([(Vertex, Vertex)]
_ , UpdateMap
umap) <- (Either String ([(Vertex, Vertex)], UpdateMap)
 -> UpdateGenerator
 -> Either String ([(Vertex, Vertex)], UpdateMap))
-> Either String ([(Vertex, Vertex)], UpdateMap)
-> [UpdateGenerator]
-> Either String ([(Vertex, Vertex)], UpdateMap)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Either String ([(Vertex, Vertex)], UpdateMap)
-> UpdateGenerator -> Either String ([(Vertex, Vertex)], UpdateMap)
forall {k} {a} {a}.
Ord k =>
Either a ([k], Map k a)
-> (BoundaryState -> [k] -> Either a (Map k a))
-> Either a ([k], Map k a)
addGen (([(Vertex, Vertex)], UpdateMap)
-> Either String ([(Vertex, Vertex)], UpdateMap)
forall a b. b -> Either a b
Right ([(Vertex, Vertex)]
focus,UpdateMap
forall k a. Map k a
Map.empty)) [UpdateGenerator]
generators
      UpdateMap -> Try UpdateMap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return UpdateMap
umap
  where
    addGen :: Either a ([k], Map k a)
-> (BoundaryState -> [k] -> Either a (Map k a))
-> Either a ([k], Map k a)
addGen (Right ([k]
es,Map k a
umap)) BoundaryState -> [k] -> Either a (Map k a)
gen = do Map k a
umap' <- BoundaryState -> [k] -> Either a (Map k a)
gen BoundaryState
bd [k]
es
                                      let es' :: [k]
es' = [k]
es [k] -> [k] -> [k]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map k a -> [k]
forall k a. Map k a -> [k]
Map.keys Map k a
umap'
                                      ([k], Map k a) -> Either a ([k], Map k a)
forall a. a -> Either a a
forall (m :: * -> *) a. Monad m => a -> m a
return ([k]
es',Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
umap' Map k a
umap) 
    addGen Either a ([k], Map k a)
other BoundaryState -> [k] -> Either a (Map k a)
_  = Either a ([k], Map k a)
other  -- fails with first failing generator
    generators :: [UpdateGenerator]
generators = [ UpdateGenerator
wholeTileUpdates          -- (rule 1)
                 , UpdateGenerator
aceKiteUpdates            -- (rule 2)
                 , UpdateGenerator
queenOrKingUpdates        -- (rule 3)
                 , UpdateGenerator
deuceDartUpdates          -- (rule 4)
                 , UpdateGenerator
jackDartUpdates           -- (rule 5)
                 , UpdateGenerator
sunStarUpdates            -- (rule 6)
                 , UpdateGenerator
jackKiteUpdates           -- (rule 7)
                 , UpdateGenerator
kingDartUpdates           -- (rule 8)
                 , UpdateGenerator
queenDartUpdates          -- (rule 9)
                 , UpdateGenerator
queenKiteUpdates          -- (rule 10)
--                 , stuckFalseQueen           -- (new: rule 11)
                 ]

-- |UFinder (Update case finder functions). Given a BoundaryState and a list of (focus) boundary directed edges,
-- such a function returns each focus edge satisfying the particular update case paired with the tileface
-- matching that edge. For example, if the function is looking for dart short edges on the boundary,
-- it will return only those focus edges which are half-dart short edges,
-- each paired with its half-dart face.
type UFinder = BoundaryState -> [Dedge] -> [(Dedge,TileFace)]

-- |UChecker (Update checker functions). Given a BoundaryState and a particular tileface (on the boundary),
-- such functions try to produce particular updates on the boundary edge of the given tileface.
-- [They are called update checkers because they may uncover an incorrect/stuck tiling (using tryFindThirdV)
-- when creating the update.]
-- As an example, addKiteShortE will try to produce an update to add a half-kite with short edge against the boundary.
-- Such a function can be used with a UFinder that either returns dart halves with short edge on the boundary
-- (nonKDarts in rule 2) or returns kite halves with short edge on the boundary
-- (kitesWingDartOrigin in rule 3).
type UChecker = BoundaryState -> TileFace -> Try Update      

{-|This is a general purpose filter used to create UFinder functions for each force rule.
 It requires a face predicate.
 The face predicate takes a BoundaryState bd, a boundary Dedge (a,b) and the TileFace with the edge (b,a)
 and decides whether the face is wanted or not (True = wanted)
 This will be used to filter all the faces at the focus edges 
 (when given a BoundaryState and list of focus edges).
 For some predicates the BoundaryState argument is not used (eg boundaryJoin in incompleteHalves), 
 but for others it is used to look at other faces at b or at a besides the supplied face 
 (eg in kitesWingDartOrigin) 
-}
boundaryFilter::  (BoundaryState -> Dedge -> TileFace -> Bool) -> UFinder
boundaryFilter :: (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predF BoundaryState
bd [(Vertex, Vertex)]
focus = 
    [ ((Vertex, Vertex)
e,TileFace
fc) | (Vertex, Vertex)
e <- [(Vertex, Vertex)]
focus 
             , TileFace
fc <- BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
e)
             , TileFace
fc TileFace -> [TileFace] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
e)
             , BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predF BoundaryState
bd (Vertex, Vertex)
e TileFace
fc
             ]

-- |makeUpdate f x constructs a safe update if x is Just .. and an unsafe update if x is Nothing
makeUpdate:: (Vertex -> TileFace) -> Maybe Vertex ->  Update
makeUpdate :: (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
f (Just Vertex
v) = TileFace -> Update
SafeUpdate (Vertex -> TileFace
f Vertex
v)
makeUpdate Vertex -> TileFace
f Maybe Vertex
Nothing  = (Vertex -> TileFace) -> Update
UnsafeUpdate Vertex -> TileFace
f


         
-- |A vertex on the boundary must be a star if it has 7 or more dart origins
mustbeStar:: BoundaryState -> Vertex -> Bool
mustbeStar :: BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v) Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>= Vertex
7

-- |A vertex on the boundary must be a sun if it has 5 or more kite origins
mustbeSun:: BoundaryState -> Vertex -> Bool
mustbeSun :: BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v) Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>= Vertex
5

-- |A vertex on the boundary which is an oppV of a kite must be a deuce
-- if there is a shared kite short edge at the vertex.
mustbeDeuce:: BoundaryState -> Vertex -> Bool
mustbeDeuce :: BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Bool
isKiteOppV BoundaryState
bd Vertex
v Bool -> Bool -> Bool
&&
                   [(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((TileFace -> (Vertex, Vertex)) -> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> (Vertex, Vertex)
shortE ([TileFace] -> [(Vertex, Vertex)])
-> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)

-- |A boundary vertex which is a kite wing and has 4 dart origins must be a king vertex
mustbeKing:: BoundaryState -> Vertex -> Bool
mustbeKing :: BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Bool
isKiteWing BoundaryState
bd Vertex
v Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dartOrigins Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
4
   where  dartOrigins :: [TileFace]
dartOrigins = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v

{-
-- |A boundary vertex which is a kite wing and dart origin must be either a king or queen
mustbeQorK:: BoundaryState -> Vertex -> Bool
mustbeQorK bd v = isDartOrigin bd v && isKiteWing bd v
-}

-- |isKiteWing bd v - Vertex v is a kite wing in BoundaryState bd
isKiteWing:: BoundaryState -> Vertex -> Bool
isKiteWing :: BoundaryState -> Vertex -> Bool
isKiteWing BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
wingV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))

-- |isKiteOppV bd v - Vertex v is a kite oppV in BoundaryState bd
isKiteOppV:: BoundaryState -> Vertex -> Bool
isKiteOppV :: BoundaryState -> Vertex -> Bool
isKiteOppV BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
oppV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))

-- |isDartOrigin bd v - Vertex v is a dart origin in BoundaryState bd
isDartOrigin:: BoundaryState -> Vertex -> Bool
isDartOrigin :: BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))

-- |A boundary vertex with >2 kite wings is a queen vertex 
-- (needing a fourth kite on a kite short edge or dart on a kite long edge)
mustbeQueen:: BoundaryState -> Vertex -> Bool
mustbeQueen :: BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Vertex
kiteWingCount BoundaryState
bd Vertex
v Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2

-- |kiteWingCount bd v - the number of kite wings at v in BoundaryState bd
kiteWingCount:: BoundaryState -> Vertex -> Int
kiteWingCount :: BoundaryState -> Vertex -> Vertex
kiteWingCount BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)

-- |mustbeJack (large dart base / jack) is true of a boundary vertex if
-- it is the wing of two darts not sharing a long edge or
-- it is a wing of a dart and also a kite origin
-- (false means it is either undetermined or is a large kite centre  - deuce)
mustbeJack :: BoundaryState -> Vertex -> Bool
mustbeJack :: BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd Vertex
v =
  ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dWings Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((TileFace -> (Vertex, Vertex)) -> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> (Vertex, Vertex)
longE [TileFace]
dWings))) Bool -> Bool -> Bool
|| -- 2 dart wings and dart long edges not shared.
  ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dWings Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
1 Bool -> Bool -> Bool
&& Bool
isKiteOrigin) 
  where fcs :: [TileFace]
fcs = BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v
        dWings :: [TileFace]
dWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart [TileFace]
fcs
        isKiteOrigin :: Bool
isKiteOrigin = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite [TileFace]
fcs)

-- |hasMatching asks if a directed edge list has any two matching (=opposing) directed edges.
hasAnyMatchingE :: [Dedge] -> Bool
hasAnyMatchingE :: [(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((Vertex
x,Vertex
y):[(Vertex, Vertex)]
more) = (Vertex
y,Vertex
x) (Vertex, Vertex) -> [(Vertex, Vertex)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Vertex, Vertex)]
more Bool -> Bool -> Bool
|| [(Vertex, Vertex)] -> Bool
hasAnyMatchingE [(Vertex, Vertex)]
more
hasAnyMatchingE [] = Bool
False

{-| makeGenerator combines an update case finder (UFinder) with its corresponding update checker (UChecker)
    to produce an update generator function.
    This is used to make each of the 10 update generators corresponding to 10 rules. 
    
    When the generator is given a BoundaryState and list of focus edges,
    the finder produces a list of pairs of dedge and face,
    the checker is used to convert the face in each pair to an update (which can fail with a Left report),
    and the new updates are returned as a map (with the dedges as key) in a Right result.
-}
makeGenerator :: UChecker -> UFinder -> UpdateGenerator
makeGenerator :: UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
checker UFinder
finder = UpdateGenerator
gen where
  gen :: UpdateGenerator
gen BoundaryState
bd [(Vertex, Vertex)]
edges = (((Vertex, Vertex), TileFace) -> Try UpdateMap -> Try UpdateMap)
-> Try UpdateMap -> [((Vertex, Vertex), TileFace)] -> Try UpdateMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Vertex, Vertex), TileFace) -> Try UpdateMap -> Try UpdateMap
forall {k}.
Ord k =>
(k, TileFace)
-> Either String (Map k Update) -> Either String (Map k Update)
addU (UpdateMap -> Try UpdateMap
forall a b. b -> Either a b
Right UpdateMap
forall k a. Map k a
Map.empty) (UFinder
finder BoundaryState
bd [(Vertex, Vertex)]
edges) where
                 addU :: (k, TileFace)
-> Either String (Map k Update) -> Either String (Map k Update)
addU (k, TileFace)
_      (Left String
x) = String -> Either String (Map k Update)
forall a b. a -> Either a b
Left String
x 
                 addU (k
e,TileFace
fc) (Right Map k Update
ump) = do Update
u <- UChecker
checker BoundaryState
bd TileFace
fc
                                              Map k Update -> Either String (Map k Update)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> Update -> Map k Update -> Map k Update
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
e Update
u Map k Update
ump)

                         
-- *  Ten Update Generators (with corresponding Finders)


-- |Update generator for rule (1)
wholeTileUpdates:: UpdateGenerator
wholeTileUpdates :: UpdateGenerator
wholeTileUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
completeHalf UFinder
incompleteHalves

-- |Find faces with missing opposite face (mirror face)  
incompleteHalves :: UFinder 
incompleteHalves :: UFinder
incompleteHalves = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
forall {p}. p -> (Vertex, Vertex) -> TileFace -> Bool
boundaryJoin where
    boundaryJoin :: p -> (Vertex, Vertex) -> TileFace -> Bool
boundaryJoin p
_ (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
joinE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)


-- |Update generator for rule (2)
aceKiteUpdates :: UpdateGenerator
aceKiteUpdates :: UpdateGenerator
aceKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
nonKDarts

-- |Find half darts with boundary short edge
nonKDarts :: UFinder            
nonKDarts :: UFinder
nonKDarts = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
forall {p}. p -> (Vertex, Vertex) -> TileFace -> Bool
bShortDarts where
    bShortDarts :: p -> (Vertex, Vertex) -> TileFace -> Bool
bShortDarts p
_ (Vertex
a,Vertex
b) TileFace
fc = TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)


-- |Update generator for rule (3)
 -- queen and king vertices add a missing kite half (on a boundary kite short edge)
queenOrKingUpdates :: UpdateGenerator
queenOrKingUpdates :: UpdateGenerator
queenOrKingUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
kitesWingDartOrigin

-- |Find kites with boundary short edge where the wing is also a dart origin
kitesWingDartOrigin :: UFinder              
kitesWingDartOrigin :: UFinder
kitesWingDartOrigin = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteWDO where
   kiteWDO :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteWDO BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) 
                         Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd (TileFace -> Vertex
wingV TileFace
fc)


{-| Update generator for rule (4)
     (for deuce vertices = largeKiteCentres)
     Kites whose short edge (b,a) matches a boundary edge (a,b) where their oppV 
     has 2 other kite halves sharing a shortE.
     These need a dart adding on the short edge.
-}
deuceDartUpdates :: UpdateGenerator
deuceDartUpdates :: UpdateGenerator
deuceDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartShortE UFinder
kiteGaps

-- |Find kite halves with a short edge on the boundary (a,b) 
-- where there are 2 other kite halves sharing a short edge
-- at oppV of the kite half (a for left kite and b for right kite)
kiteGaps :: UFinder              
kiteGaps :: UFinder
kiteGaps = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteGap where
  kiteGap :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteGap BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
                        Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd (TileFace -> Vertex
oppV TileFace
fc)


-- |Update generator for rule (5)
-- jackDartUpdates - jack vertex add a missing second dart
jackDartUpdates :: UpdateGenerator
jackDartUpdates :: UpdateGenerator
jackDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartShortE UFinder
noTouchingDart

-- |Find kite halves with a short edge on the boundary (a,b) where oppV is a largeDartBase vertex
-- (oppV is a for left kite and b for right kite).
-- The function mustbeJack determines if a vertex must be a a largeDartBase / jack
noTouchingDart :: UFinder              
noTouchingDart :: UFinder
noTouchingDart = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
farKOfDarts where
   farKOfDarts :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
farKOfDarts BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc  = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
                              Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
oppV TileFace
fc)

{-| Update generator for rule (6)
sunStarUpdates is for vertices that must be either sun or star 
almostSunStar finds half-kites/half-darts with a long edge on the boundary
where their origin vertex has 8 total half-kites/half-darts respectively
or their origin vertex has 6 total half-kites in the case of kites only
completeSunStar will add a new face of the same type (dart/kite) 
sharing the long edge.
-}
sunStarUpdates :: UpdateGenerator
sunStarUpdates :: UpdateGenerator
sunStarUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
completeSunStar UFinder
almostSunStar

-- |Find a boundary long edge of either
-- a dart where there are at least 7 dart origins, or
-- a kite where there are at least 5 kite origins
almostSunStar :: UFinder                  
almostSunStar :: UFinder
almostSunStar = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
multiples57 where
    multiples57 :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
multiples57 BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&           
        ((TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc)) Bool -> Bool -> Bool
||
         (TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc))
        )

-- |Update generator for rule (7)
-- jack vertices (largeDartBases) with dart long edge on boundary - add missing kite top
jackKiteUpdates :: UpdateGenerator
jackKiteUpdates :: UpdateGenerator
jackKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteLongE UFinder
jackMissingKite

-- |Find jack vertices (largeDartBases) with dart long edge on the boundary
jackMissingKite :: UFinder                  
jackMissingKite :: UFinder
jackMissingKite = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
dartsWingDB where
    dartsWingDB :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
dartsWingDB BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&
                              TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
wingV TileFace
fc)

-- |Update generator for rule (8)
-- king vertices with 2 of the 3 darts  - add another half dart on a boundary long edge of existing darts
kingDartUpdates :: UpdateGenerator
kingDartUpdates :: UpdateGenerator
kingDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartLongE UFinder
kingMissingThirdDart

-- |Find king vertices with a dart long edge on the boundary
-- and 2 of the 3 darts at its origin plus a kite wing at its origin
kingMissingThirdDart :: UFinder                    
kingMissingThirdDart :: UFinder
kingMissingThirdDart = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
    predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&
        TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc)


-- |Update generator for rule (9)
-- queen vertices (with 4 kite wings) -- add any missing half dart on a boundary kite long edge
queenDartUpdates :: UpdateGenerator
queenDartUpdates :: UpdateGenerator
queenDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartLongE UFinder
queenMissingDarts

-- |Find queen vertices (with 3 or 4 kite wings) and a boundary kite long edge
queenMissingDarts :: UFinder                      
queenMissingDarts :: UFinder
queenMissingDarts = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
    predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = 
        TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
kiteWings Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2
           where fcWing :: Vertex
fcWing = TileFace -> Vertex
wingV TileFace
fc
                 kiteWings :: [TileFace]
kiteWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
fcWing) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ 
                             (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
fcWing
                                      
-- |Update generator for rule (10)
-- queen vertices with 3 kite wings -- add missing fourth half kite on a boundary kite short edge
queenKiteUpdates :: UpdateGenerator
queenKiteUpdates :: UpdateGenerator
queenKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
queenMissingKite

-- |Find queen vertices with only 3 kite wings and a kite short edge on the boundary
queenMissingKite :: UFinder                        
queenMissingKite :: UFinder
queenMissingKite = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
    predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = 
        TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
kiteWings Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2
           where fcWing :: Vertex
fcWing = TileFace -> Vertex
wingV TileFace
fc
                 kiteWings :: [TileFace]
kiteWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
fcWing) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
fcWing)


-- *  Six Update Checkers


-- |completeHalf will check an update to
--  add a symmetric (mirror) face for a given face at a boundary join edge.
completeHalf :: UChecker      
completeHalf :: UChecker
completeHalf BoundaryState
bd (LD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RD(Vertex
a,b
v,Vertex
b)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
3,Vertex
1) --anglesForJoinRD
completeHalf BoundaryState
bd (RD(Vertex
a,Vertex
_,Vertex
b)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LD(Vertex
a,Vertex
b,c
v)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
1,Vertex
3) --anglesForJoinLD
completeHalf BoundaryState
bd (LK(Vertex
a,Vertex
_,Vertex
b)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RK(Vertex
a,Vertex
b,c
v)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
1,Vertex
2) --anglesForJoinRK
completeHalf BoundaryState
bd (RK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LK(Vertex
a,b
v,Vertex
b)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
2,Vertex
1) --anglesForJoinLK

-- |add a (missing) half kite on a (boundary) short edge of a dart or kite
addKiteShortE :: UChecker         
addKiteShortE :: UChecker
addKiteShortE BoundaryState
bd (RD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LK(a
v,Vertex
c,Vertex
b)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2) --anglesForShortLK
addKiteShortE BoundaryState
bd (LD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RK(a
v,Vertex
c,Vertex
b)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2) --anglesForShortRK
addKiteShortE BoundaryState
bd (LK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RK(a
v,Vertex
c,Vertex
b)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2) --anglesForShortRK
addKiteShortE BoundaryState
bd (RK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LK(a
v,Vertex
c,Vertex
b)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2) --anglesForShortLK

-- |add a half dart top to a boundary short edge of a half kite.
addDartShortE :: UChecker         
addDartShortE :: UChecker
addDartShortE BoundaryState
bd (RK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LD(a
v,Vertex
c,Vertex
b)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
3,Vertex
1) --anglesForShortLD
addDartShortE BoundaryState
bd (LK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
        makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RD(a
v,Vertex
c,Vertex
b)
        x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
1,Vertex
3) --anglesForShortRD
addDartShortE BoundaryState
_  TileFace
_ = String -> Try Update
forall a. HasCallStack => String -> a
error String
"addDartShortE applied to non-kite face\n"

-- |add a kite half to a kite long edge or dart half to a dart long edge
completeSunStar :: UChecker
completeSunStar :: UChecker
completeSunStar BoundaryState
bd TileFace
fc = if TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc 
                        then UChecker
addKiteLongE BoundaryState
bd TileFace
fc
                        else UChecker
addDartLongE BoundaryState
bd TileFace
fc

-- |add a kite to a long edge of a dart or kite
addKiteLongE :: UChecker            
addKiteLongE :: UChecker
addKiteLongE BoundaryState
bd (LD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RK(Vertex
c,b
v,Vertex
a)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
2,Vertex
1) -- anglesForLongRK
addKiteLongE BoundaryState
bd (RD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
    makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LK(Vertex
b,Vertex
a,c
v)
    x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
2) -- anglesForLongLK
addKiteLongE BoundaryState
bd (RK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LK(Vertex
a,Vertex
c,c
v)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
2) -- anglesForLongLK
addKiteLongE BoundaryState
bd (LK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RK(Vertex
a,b
v,Vertex
b)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
2,Vertex
1) -- anglesForLongRK

-- |add a half dart on a boundary long edge of a dart or kite
addDartLongE :: UChecker            
addDartLongE :: UChecker
addDartLongE BoundaryState
bd (LD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RD(Vertex
a,Vertex
c,c
v)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
1) -- anglesForLongRD
addDartLongE BoundaryState
bd (RD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LD(Vertex
a,b
v,Vertex
b)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
1) -- anglesForLongLD
addDartLongE BoundaryState
bd (LK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RD(Vertex
b,Vertex
a,c
v)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
1) -- anglesForLongRD
addDartLongE BoundaryState
bd (RK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
  makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LD(Vertex
c,b
v,Vertex
a)
  x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
1) -- anglesForLongLD

{-
-- |mnemonic for internal angles of an edge (expressed as integer units of a tenth turn (I.e 1,2 or 3)
anglesForJoinRD,anglesForJoinLD,anglesForJoinRK,anglesForJoinLK::(Int,Int)
anglesForJoinRD = (3,1)
anglesForJoinLD = (1,3)
anglesForJoinRK = (1,2)
anglesForJoinLK = (2,1)
-- |mnemonic for internal angles of an edge (expressed as integer units of a tenth turn (I.e 1,2 or 3)
anglesForLongLD,anglesForLongRD,anglesForLongRK,anglesForLongLK::(Int,Int)
anglesForLongLD = (1,1)
anglesForLongRD = (1,1)
anglesForLongRK = (2,1)
anglesForLongLK = (1,2)
-- |mnemonic for internal angles of an edge (expressed as integer units of a tenth turn (I.e 1,2 or 3)
anglesForShortLD,anglesForShortRD,anglesForShortLK,anglesForShortRK::(Int,Int)
anglesForShortLD = (3,1)
anglesForShortRD = (1,3)
anglesForShortLK = (2,2)
anglesForShortRK = (2,2)
-}


-- *  The Default All Update Generator (defaultAllUGen)


-- |An alternative to allUGenerator, and used as the default. It uses the same rules and UCheckers,
-- but makes decisions based on the EdgeType of a boundary edge (instead of trying each UFinder in turn).
-- If there are any Left..(fail reports) for the given
-- boundary edges the result is a sigle Left.. concatenating all the failure reports (unlike allUGenerator).
defaultAllUGen :: UpdateGenerator
defaultAllUGen :: UpdateGenerator
defaultAllUGen BoundaryState
bd [(Vertex, Vertex)]
es = [Try UpdateMap] -> Try UpdateMap
combine ([Try UpdateMap] -> Try UpdateMap)
-> [Try UpdateMap] -> Try UpdateMap
forall a b. (a -> b) -> a -> b
$ ((Vertex, Vertex) -> Try UpdateMap)
-> [(Vertex, Vertex)] -> [Try UpdateMap]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Try UpdateMap
decide [(Vertex, Vertex)]
es  where -- Either String is a monoid as well as Map
  decide :: (Vertex, Vertex) -> Try UpdateMap
decide (Vertex, Vertex)
e = ((Vertex, Vertex), TileFace, EdgeType) -> Try UpdateMap
forall {k}.
Ord k =>
(k, TileFace, EdgeType) -> Either String (Map k Update)
decider ((Vertex, Vertex)
e,TileFace
f,EdgeType
etype) where (TileFace
f,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
e

  decider :: (k, TileFace, EdgeType) -> Either String (Map k Update)
decider (k
e,TileFace
f,EdgeType
Join)  = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeHalf BoundaryState
bd TileFace
f) -- rule 1
  decider (k
e,TileFace
f,EdgeType
Short) 
    | TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
f = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteShortE BoundaryState
bd TileFace
f) -- rule 2
    | Bool
otherwise = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
kiteShortDecider k
e TileFace
f 
  decider (k
e,TileFace
f,EdgeType
Long)  
    | TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
f = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
dartLongDecider k
e TileFace
f
    | Bool
otherwise = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
kiteLongDecider k
e TileFace
f 

  dartLongDecider :: k -> TileFace -> Either String (Map k Update)
dartLongDecider k
e TileFace
f
    | BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeSunStar BoundaryState
bd TileFace
f)
    | BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartLongE BoundaryState
bd TileFace
f)
    | BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteLongE BoundaryState
bd TileFace
f)
    | Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty

  kiteLongDecider :: k -> TileFace -> Either String (Map k Update)
kiteLongDecider k
e TileFace
f
    | BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeSunStar BoundaryState
bd TileFace
f)
    | BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartLongE BoundaryState
bd TileFace
f)
    | Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty

  kiteShortDecider :: k -> TileFace -> Either String (Map k Update)
kiteShortDecider k
e TileFace
f
    | BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd (TileFace -> Vertex
oppV TileFace
f) Bool -> Bool -> Bool
|| BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
oppV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartShortE BoundaryState
bd TileFace
f)
    | BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) Bool -> Bool -> Bool
|| BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteShortE BoundaryState
bd TileFace
f)
    | Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty

  mapItem :: k -> f a -> f (Map k a)
mapItem k
e = (a -> Map k a) -> f a -> f (Map k a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
u -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
e a
u Map k a
forall k a. Map k a
Map.empty)
  combine :: [Try UpdateMap] -> Try UpdateMap
combine = ([UpdateMap] -> UpdateMap)
-> Either String [UpdateMap] -> Try UpdateMap
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [UpdateMap] -> UpdateMap
forall a. Monoid a => [a] -> a
mconcat (Either String [UpdateMap] -> Try UpdateMap)
-> ([Try UpdateMap] -> Either String [UpdateMap])
-> [Try UpdateMap]
-> Try UpdateMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Try UpdateMap] -> Either String [UpdateMap]
forall a. [Try a] -> Try [a]
concatFails -- concatenates all failure reports if there are any
                                       -- otherwise combines the update maps with mconcat

-- |Given a BoundaryState and a directed boundary edge, this returns the same edge with
-- the unique face on that edge and the edge type for that face and edge (Short/Long/Join)
inspectBDedge:: BoundaryState -> Dedge -> (TileFace, EdgeType)
inspectBDedge :: BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
e = (TileFace
face,(Vertex, Vertex) -> TileFace -> EdgeType
edgeType ((Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e) TileFace
face) where
    face :: TileFace
face = case BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
e) [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
e) of
         [TileFace
f] -> TileFace
f
         [TileFace]
_ -> String -> TileFace
forall a. HasCallStack => String -> a
error (String -> TileFace) -> String -> TileFace
forall a b. (a -> b) -> a -> b
$ String
"inspectBDedge: Not a boundary directed edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"




-- *  Auxiliary Functions for adding faces: externalAngle and tryFindThirdV. $Additions


{- $Additions
  
The difficulty of adding faces is determining if any edges of a new face already exist.
This goes beyond a simple graph operation and requires use of the internal angles of the faces.
We use a representation of angles which allows an equality test.
All angles are integer multiples of 1/10th turn (mod 10) so we use
these integers for comparing angles n where n is 0..9


No crossing boundary property:
It is important that there are no crossing boundaries, otherwise external angle calculations could be wrong.

Possible Touching Vertices.
When tryFindThirdV returns Nothing, this means a new vertex needs to be created.
This will need to have its position checked against other (boundary) vertices to avoid
creating a touching vertex/crossing boundary. (Taken care of in tryUnsafeUpdate)
---------------------------------}

{-|tryFindThirdV finds a neighbouring third vertex on the boundary if there is one in the correct direction for a face added to
   the right hand side of a directed boundary edge.
   In tryFindThirdV bd (a,b) (n,m), the two integer arguments n and m are the INTERNAL angles
   for the new face on the boundary directed edge (a,b)
   (for a and b respectively) expressed as multiples of tt (tt being a tenth turn)
   and must both be either 1,2, or 3.
   tryFindThirdV compares these internal angles with the external angles of the boundary calculated at a and b.
   If one of them matches, then an adjacent boundary edge will lead to the required vertex.
   If either n or m is too large a Left report is returned indicating an incorrect graph (stuck tiling).
   If n and m are smaller than the respective external angles, Right Nothing is returned.
-}
tryFindThirdV:: BoundaryState -> Dedge -> (Int,Int) -> Try (Maybe Vertex)
tryFindThirdV :: BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
n,Vertex
m) = Either String (Maybe Vertex)
maybeV where
    aAngle :: Vertex
aAngle = BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
a
    bAngle :: Vertex
bAngle = BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
b
    maybeV :: Either String (Maybe Vertex)
maybeV | Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 Bool -> Bool -> Bool
|| Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
9 
                = String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: vertex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has (tt) external angle " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
aAngle
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwhen adding to boundary directed edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b)
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
a) 
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
b)
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand a total of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" faces.\n"
           | Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 Bool -> Bool -> Bool
|| Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
9 
                = String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: vertex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has (tt) external angle " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
bAngle
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwhen adding to boundary directed edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b)
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
a) 
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
b)
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand a total of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" faces.\n"
           | Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
n 
                = String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Found incorrect graph (stuck tiling)\nConflict at edge: " 
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
           | Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
m
                = String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Found incorrect graph (stuck tiling)\nConflict at edge: " 
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
           | Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
n = case ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> Maybe (Vertex, Vertex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a) (Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd) of
                             Just (Vertex, Vertex)
pr -> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right (Maybe Vertex -> Either String (Maybe Vertex))
-> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ Vertex -> Maybe Vertex
forall a. a -> Maybe a
Just ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
pr)
                             Maybe (Vertex, Vertex)
Nothing -> String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Impossible boundary. No predecessor/successor Dedge for Dedge " 
                                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
           | Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
m = case ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> Maybe (Vertex, Vertex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b) (Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd) of
                             Just (Vertex, Vertex)
pr -> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right (Maybe Vertex -> Either String (Maybe Vertex))
-> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ Vertex -> Maybe Vertex
forall a. a -> Maybe a
Just ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
pr)
                             Maybe (Vertex, Vertex)
Nothing -> String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Impossible boundary. No predecessor/successor Dedge for Dedge " 
                                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
           | Bool
otherwise =   Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right  Maybe Vertex
forall a. Maybe a
Nothing

-- |externalAngle bd v - calculates the external angle at boundary vertex v in BoundaryState bd as an
-- integer multiple of tt (tenth turn), so 1..9.  It relies on there being no crossing boundaries,
-- so that there is a single external angle at each boundary vertex. 
externalAngle:: BoundaryState -> Vertex -> Int
externalAngle :: BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
v = Vertex
10 Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
- [Vertex] -> Vertex
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex -> TileFace -> Vertex
intAngleAt Vertex
v) ([TileFace] -> [Vertex]) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)
  
-- |intAngleAt v fc gives the internal angle of the face fc at vertex v (which must be a vertex of the face)
-- in terms of tenth turns, so returning an Int (1,2,or 3).
intAngleAt :: Vertex -> TileFace -> Int
intAngleAt :: Vertex -> TileFace -> Vertex
intAngleAt Vertex
v TileFace
fc = TileFace -> [Vertex]
faceIntAngles TileFace
fc [Vertex] -> Vertex -> Vertex
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex -> TileFace -> Vertex
indexV Vertex
v TileFace
fc

-- |faceIntAngles returns a list of the three internal angles of a face (clockwise from originV)
-- in terms of tenth turns - always 1 or 2 for kites and 1 or 3 for darts.
faceIntAngles :: TileFace -> [Int]
faceIntAngles :: TileFace -> [Vertex]
faceIntAngles (LD (Vertex, Vertex, Vertex)
_) = [Vertex
1,Vertex
3,Vertex
1]
faceIntAngles (RD (Vertex, Vertex, Vertex)
_) = [Vertex
1,Vertex
1,Vertex
3]
faceIntAngles TileFace
_      = [Vertex
1,Vertex
2,Vertex
2] -- LK and RK