Remove dummy type from RefinementInterface

The type `h` was only needed to make instance resolution unambiguous,
but type application can do that, too.

src/Algorithm.hs

+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Algorithm
   ( initializeAll
   , finalizeStates
@@ -36,7 +38,6 @@ import           Data.Algorithm.PossibleMajorityCandidate
 data AlgoState s h = AlgoState
   { toSub :: MVector s [EdgeRef]
   , lastW :: MVector s (STRef s (RI.Weight h))
-  , functor :: h -- TODO Shouldn't be needed
   , encoding :: Encoding (RI.Label h) (RI.H1 h)
   , pred :: Vector [EdgeRef]
   , partition :: RefinablePartition s
@@ -45,8 +46,8 @@ data AlgoState s h = AlgoState
 
 -- nextSize is the node count of the target set. All target indices in the given
 -- edge set must fall into this range.
-initialize :: RefinementInterface h => h -> Encoding (RI.Label h) (RI.H1 h) -> Int -> ST s (AlgoState s h)
-initialize functor encoding nextSize = do
+initialize :: forall h s. RefinementInterface h => Encoding (RI.Label h) (RI.H1 h) -> Int -> ST s (AlgoState s h)
+initialize encoding nextSize = do
   toSub <- VM.replicate (size encoding) []
   lastW <- VM.new (length (edges encoding))
   predMutable <- VM.replicate nextSize []
@@ -60,7 +61,7 @@ initialize functor encoding nextSize = do
 
   forM_ (elements encoding) $ \x -> do
     outgoingLabels <- map (label . graph encoding) <$> VM.read toSub x
-    px <- newSTRef $ RI.init functor (typeOf encoding x) outgoingLabels
+    px <- newSTRef $ RI.init @h (typeOf encoding x) outgoingLabels
 
     VM.read toSub x >>= mapM_ (\(EdgeRef e) -> VM.write lastW e px)
     VM.write toSub x []
@@ -86,14 +87,14 @@ split statesOfS = do
     whenM (lift $ Partition.hasMarked (partition as) b) $
       splitBlock b
 
-updateBlock :: RefinementInterface h => Block -> RI.H3 h -> SplitM s h ()
+updateBlock :: forall s h. RefinementInterface h => Block -> RI.H3 h -> SplitM s h ()
 updateBlock b v0 = ask >>= \as -> lift $ do
   markB <- Partition.markedStates (partition as) b
   forM_ markB $ \x -> do
     pc <- (fromEdgeRef . head <$> VM.read (toSub as) x)
             >>= VM.read (lastW as)
     labelsToS <- map (label . graph (encoding as)) <$> VM.read (toSub as) x
-    (wxS, vx, wxCwithoutS) <- RI.update (functor as) labelsToS <$> readSTRef pc
+    (wxS, vx, wxCwithoutS) <- RI.update @h labelsToS <$> readSTRef pc
     writeSTRef pc wxCwithoutS
     ps <- newSTRef wxS
     VM.read (toSub as) x >>= \edges -> forM_ edges $ \(EdgeRef e) ->
@@ -130,7 +131,7 @@ splitBlock b = ask >>= \as -> lift $ do
   -- TODO Insert blocks except a largest into queue
   undefined
 
-collectTouchedBlocks :: RefinementInterface h => Vector State -> SplitM s h [(Block, RI.H3 h)]
+collectTouchedBlocks :: forall s h. RefinementInterface h => Vector State -> SplitM s h [(Block, RI.H3 h)]
 collectTouchedBlocks statesOfS = do
   as <- ask
 
@@ -142,7 +143,7 @@ collectTouchedBlocks statesOfS = do
 
     unlessM (Partition.hasMarked (partition as) b) $ do
       wCx <- readSTRef =<< VM.read (lastW as) (fromEdgeRef e)
-      let v0 = snd3 $ RI.update (functor as) [] wCx
+      let v0 = snd3 $ RI.update @h [] wCx
       modifySTRef markedBlocks ((b, v0):)
 
     whenM (null <$> VM.read (toSub as) x) $
@@ -159,8 +160,8 @@ initializeAll :: Vector Morphism -> ST s (Vector (SomeAlgoState s))
 initializeAll encodings = do
   let sizes = fmap (\(Morphism _ x) -> size x) encodings
 
-  forM (V.zip encodings (rotateVectorLeft sizes)) $ \(Morphism h encoding, nextSize) ->
-    SomeAlgoState <$> initialize h encoding nextSize
+  forM (V.zip encodings (rotateVectorLeft sizes)) $ \(Morphism (h :: h) encoding, nextSize) ->
+    SomeAlgoState <$> initialize @h encoding nextSize
 
 iforM_ :: Monad m => Vector a -> (Int -> a -> m b) -> m ()
 iforM_ = flip V.imapM_
@@ -179,7 +180,6 @@ rotateVectorLeft vec =
 data NonSTAlgoState h = NonSTAlgoState
   { nonSTToSub :: Vector [EdgeRef]
   , nonSTLastW :: Vector (RI.Weight h)
-  , nonSTFunctor :: h -- TODO Shouldn't be needed
   , nonSTEncoding :: Encoding (RI.Label h) (RI.H1 h)
   , nonSTPred :: Vector [EdgeRef]
   -- refineable partition
@@ -192,8 +192,7 @@ finalizeState :: AlgoState s h -> ST s (NonSTAlgoState h)
 finalizeState state = do
   nonSTToSub <- V.freeze (toSub state)
   nonSTLastW <- V.freeze (lastW state) >>= mapM readSTRef
-  let nonSTFunctor = functor state
-      nonSTEncoding = encoding state
+  let nonSTEncoding = encoding state
       nonSTPred = pred state
 
   return $ NonSTAlgoState {..}

src/Data/Functors/FixedProduct.hs

@@ -45,12 +45,12 @@ instance RefinementInterface FixedProduct where
           Nothing -> fail $ "Label" ++ T.unpack txt ++ " not defined"
           Just labelIdx -> return (labelIdx, Edge morphIdx () morphIdx)
 
-  init :: FixedProduct -> H1 FixedProduct -> [Label FixedProduct] -> Weight FixedProduct
-  init _ tag _ = (tag, True) -- the edge points somewhere in the whole Y set => True
+  init :: H1 FixedProduct -> [Label FixedProduct] -> Weight FixedProduct
+  init tag _ = (tag, True) -- the edge points somewhere in the whole Y set => True
 
-  update :: FixedProduct -> [Label FixedProduct] -> Weight FixedProduct
+  update :: [Label FixedProduct] -> Weight FixedProduct
          -> (Weight FixedProduct, H3 FixedProduct, Weight FixedProduct)
-  update _ edgesToS (tag, toC) =
+  update edgesToS (tag, toC) =
     let
       toS = not (null edgesToS)
       three = case (toS, toC) of

src/Data/Functors/Powerset.hs

@@ -40,12 +40,12 @@ instance RefinementInterface Powerset where
       parseNode :: Int -> Yaml.Value -> Yaml.Parser (Int, Vector Int)
       parseNode nodeIdx value = (nodeIdx,) <$> Yaml.parseJSON value
 
-  init :: Powerset -> H1 Powerset -> [Label Powerset] -> Weight Powerset
-  init _ _ = (0, ) . length
+  init :: H1 Powerset -> [Label Powerset] -> Weight Powerset
+  init _ = (0, ) . length
 
-  update :: Powerset -> [Label Powerset] -> Weight Powerset
+  update :: [Label Powerset] -> Weight Powerset
          -> (Weight Powerset, H3 Powerset, Weight Powerset)
-  update _ labels (toRest, toC) =
+  update labels (toRest, toC) =
     let
       toS = length labels
       toCwithoutS = toC - toS

src/Data/RefinementInterface.hs

+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE Rank2Types #-}
@@ -29,5 +30,5 @@ class (Show h, Show (Label h), Show (H1 h), Show (Weight h), Ord (H1 h), Ord (H3
   type H3 h :: *
 
   parse :: h -> Vector Yaml.Value -> Yaml.Parser (Encoding (Label h) (H1 h))
-  init :: h -> H1 h -> [Label h] -> Weight h
-  update :: h -> [Label h] -> Weight h -> (Weight h, H3 h, Weight h)
+  init :: H1 h -> [Label h] -> Weight h
+  update :: [Label h] -> Weight h -> (Weight h, H3 h, Weight h)