{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.BalancedParens.NewCloseAt
  ( NewCloseAt(..)
  , newCloseAt'
  ) where

import Data.Word
import HaskellWorks.Data.Bits.BitLength
import HaskellWorks.Data.Bits.BitShown
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Positioning

import qualified Data.Vector.Storable as DVS

class NewCloseAt v where
  newCloseAt :: v -> Count -> Bool

newCloseAt' :: TestBit a => a -> Count -> Bool
newCloseAt' :: a -> Count -> Bool
newCloseAt' a
v Count
c = Bool -> Bool
not (a
v a -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Count -> Position
forall a. ToPosition a => a -> Position
toPosition Count
c)
{-# INLINE newCloseAt' #-}

instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where
  newCloseAt :: BitShown a -> Count -> Bool
newCloseAt = a -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt' (a -> Count -> Bool)
-> (BitShown a -> a) -> BitShown a -> Count -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitShown a -> a
forall a. BitShown a -> a
bitShown
  {-# INLINE newCloseAt #-}

instance NewCloseAt [Bool] where
  newCloseAt :: [Bool] -> Count -> Bool
newCloseAt = [Bool] -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt (DVS.Vector Word8) where
  newCloseAt :: Vector Word8 -> Count -> Bool
newCloseAt = Vector Word8 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt (DVS.Vector Word16) where
  newCloseAt :: Vector Word16 -> Count -> Bool
newCloseAt = Vector Word16 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt (DVS.Vector Word32) where
  newCloseAt :: Vector Word32 -> Count -> Bool
newCloseAt = Vector Word32 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt (DVS.Vector Word64) where
  newCloseAt :: Vector Count -> Count -> Bool
newCloseAt = Vector Count -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt Word8 where
  newCloseAt :: Word8 -> Count -> Bool
newCloseAt = Word8 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt Word16 where
  newCloseAt :: Word16 -> Count -> Bool
newCloseAt = Word16 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt Word32 where
  newCloseAt :: Word32 -> Count -> Bool
newCloseAt = Word32 -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}

instance NewCloseAt Word64 where
  newCloseAt :: Count -> Count -> Bool
newCloseAt = Count -> Count -> Bool
forall a. TestBit a => a -> Count -> Bool
newCloseAt'
  {-# INLINE newCloseAt #-}