Commits

Aleksey Khudyakov committed bedf9e4

Change definition of fromContainer method.

Add parameter for passing mapM_ function for given container
It woild allow to fill from non-Foldable containers e.g. vectors

Comments (0)

Files changed (1)

Data/Histogram/Fill.hs

     -- | Change input of builder by applying function to it.
     modifyIn      :: (a' -> a) -> h a b -> h a' b
     -- | Put all values in container into builder 
-    fromContainer :: F.Foldable f => h a b -> h (f a) b
+    fromContainer :: (forall m. Monad m => (a -> m ()) -> f a -> m ())
+                     -- ^ @mapM_@ function for container
+                  -> h a b -> h (f a) b
     -- | Add cut to histogram. Value would be putted into histogram
     --   only if condition is true. 
     addCut        :: (a -> Bool) -> h a b -> h a b
 
 -- | Modify input of builder to use composite input
 (<<-|) :: (HistBuilder h, F.Foldable f) => h a b -> (a' -> f a) -> h a' b
-h <<-| f = fromContainer h <<- f
+h <<-| f = fromContainer F.mapM_ h <<- f
 {-# INLINE (<<-|) #-}
 
 -- | Add cut for input
 
 -- | Builders modified using 'HistBuilder' API will share same buffer.
 instance PrimMonad m => HistBuilder (HBuilderM m) where
-    modifyIn    f h = h { hbInput  = hbInput h . f }
-    addCut      f h = h { hbInput  = \x -> when (f x) (hbInput h x) }
-    fromContainer h = h { hbInput  = F.mapM_ (hbInput h) }
-    modifyOut   f h = h { hbOutput = f `liftM` hbOutput h }
+    modifyIn      f      h = h { hbInput  = hbInput h . f }
+    addCut        f      h = h { hbInput  = \x -> when (f x) (hbInput h x) }
+    fromContainer fmapM_ h = h { hbInput  = fmapM_ (hbInput h) }
+    modifyOut     f      h = h { hbOutput = f `liftM` hbOutput h }
 
 instance PrimMonad m => Functor (HBuilderM m a) where
     fmap = modifyOut
           (stToIO $ hbOutput builder))
 
 instance HistBuilder (HBuilder) where
-    modifyIn    f (HBuilder h) = HBuilder (modifyIn  f <$> h)
-    addCut      f (HBuilder h) = HBuilder (addCut    f <$> h)
-    fromContainer (HBuilder h) = HBuilder (fromContainer <$> h)
-    modifyOut   f (HBuilder h) = HBuilder (modifyOut f <$> h)
+    modifyIn      f      (HBuilder h) = HBuilder (modifyIn  f <$> h)
+    addCut        f      (HBuilder h) = HBuilder (addCut    f <$> h)
+    fromContainer fmapM_ (HBuilder h) = HBuilder (fromContainer fmapM_ <$> h)
+    modifyOut     f      (HBuilder h) = HBuilder (modifyOut f <$> h)
 
 instance Functor (HBuilder a) where
     fmap = modifyOut