msakai / toysolver / 496

Committed 10 Nov 2024 11:05AM UTC coverage: 69.994% (-1.1%) from 71.113%

Build # 496

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #117 from msakai/update-coveralls-and-haddock

GitHub Actions: Update coveralls and haddock configuration

Run Details

9872 of 14104 relevant lines covered (69.99%)

0.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

77.27

/src/ToySolver/Internal/Data/SeqQueue.hs

{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Internal.Data.SeqQueue
-- Copyright   :  (c) Masahiro Sakai 2012
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- Queue implemented using IORef and Sequence.
--
-----------------------------------------------------------------------------
module ToySolver.Internal.Data.SeqQueue
  (
  -- * SeqQueue type
    SeqQueue

  -- * Constructors
  , NewFifo (..)

  -- * Operators
  , Enqueue (..)
  , Dequeue (..)
  , QueueSize (..)
  , clear
  ) where

import Control.Monad.Primitive
import Control.Monad.ST
import Data.Queue
import Data.Foldable
import Data.Primitive.MutVar
import qualified Data.Sequence as Seq

newtype SeqQueue m a = SeqQueue (MutVar (PrimState m) (Seq.Seq a))

instance PrimMonad m => NewFifo (SeqQueue m a) m where
  {-# INLINE newFifo #-}
  newFifo = do
    ref <- newMutVar Seq.empty
    return (SeqQueue ref)

instance PrimMonad m => Enqueue (SeqQueue m a) m a where
  {-# INLINE enqueue #-}
  enqueue (SeqQueue ref) val = do
    modifyMutVar ref (Seq.|> val)

instance PrimMonad m => Dequeue (SeqQueue m a) m a where
  {-# INLINE dequeue #-}
  dequeue (SeqQueue ref) = do
    s <- readMutVar ref
    case Seq.viewl s of
      Seq.EmptyL -> return Nothing
      val Seq.:< s' -> do
        writeMutVar ref s'
        return (Just val)

  {-# INLINE dequeueBatch #-}
  dequeueBatch (SeqQueue ref) = do
    s <- readMutVar ref
    writeMutVar ref Seq.empty
    return (toList s)

instance PrimMonad m => QueueSize (SeqQueue m a) m where
  {-# INLINE queueSize #-}
  queueSize (SeqQueue ref) = do
    s <- readMutVar ref
    return $! Seq.length s

{-# INLINE clear #-}
clear :: PrimMonad m => SeqQueue m a -> m ()
clear (SeqQueue ref) = do
  writeMutVar ref Seq.empty

1	{-# OPTIONS_HADDOCK show-extensions #-}
2	{-# LANGUAGE FlexibleInstances #-}
3	{-# LANGUAGE MultiParamTypeClasses #-}
4	-----------------------------------------------------------------------------
5	-- \|
6	-- Module : ToySolver.Internal.Data.SeqQueue
7	-- Copyright : (c) Masahiro Sakai 2012
8	-- License : BSD-style
9	--
10	-- Maintainer : masahiro.sakai@gmail.com
11	-- Stability : provisional
12	-- Portability : non-portable
13	--
14	-- Queue implemented using IORef and Sequence.
15	--
16	-----------------------------------------------------------------------------
17	module ToySolver.Internal.Data.SeqQueue
18	(
19	-- * SeqQueue type
20	SeqQueue
21
22	-- * Constructors
23	, NewFifo (..)
24
25	-- * Operators
26	, Enqueue (..)
27	, Dequeue (..)
28	, QueueSize (..)
29	, clear
30	) where
31
32	import Control.Monad.Primitive
33	import Control.Monad.ST
34	import Data.Queue
35	import Data.Foldable
36	import Data.Primitive.MutVar
37	import qualified Data.Sequence as Seq
38
39	newtype SeqQueue m a = SeqQueue (MutVar (PrimState m) (Seq.Seq a))
40
41	instance PrimMonad m => NewFifo (SeqQueue m a) m where
42	{-# INLINE newFifo #-}
43	newFifo = do	1✔
44	ref <- newMutVar Seq.empty	1✔
45	return (SeqQueue ref)	1✔
46
47	instance PrimMonad m => Enqueue (SeqQueue m a) m a where	×
48	{-# INLINE enqueue #-}
49	enqueue (SeqQueue ref) val = do	1✔
50	modifyMutVar ref (Seq.\|> val)	1✔
51
52	instance PrimMonad m => Dequeue (SeqQueue m a) m a where
53	{-# INLINE dequeue #-}
54	dequeue (SeqQueue ref) = do	1✔
55	s <- readMutVar ref	1✔
56	case Seq.viewl s of	1✔
57	Seq.EmptyL -> return Nothing	×
58	val Seq.:< s' -> do	1✔
59	writeMutVar ref s'	1✔
60	return (Just val)	1✔
61
62	{-# INLINE dequeueBatch #-}
63	dequeueBatch (SeqQueue ref) = do	1✔
64	s <- readMutVar ref	1✔
65	writeMutVar ref Seq.empty	×
66	return (toList s)	1✔
67
68	instance PrimMonad m => QueueSize (SeqQueue m a) m where
69	{-# INLINE queueSize #-}
70	queueSize (SeqQueue ref) = do	1✔
71	s <- readMutVar ref	1✔
72	return $! Seq.length s	1✔
73
74	{-# INLINE clear #-}
75	clear :: PrimMonad m => SeqQueue m a -> m ()
76	clear (SeqQueue ref) = do	×
77	writeMutVar ref Seq.empty	×

msakai / toysolver / 496

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous