{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.BalancedParens.CloseAt
  ( CloseAt(..)
  ) where

import Data.Vector.Storable                  as DVS
import Data.Word
import HaskellWorks.Data.Bits.BitLength
import HaskellWorks.Data.Bits.BitShown
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Bits.Broadword.Type
import HaskellWorks.Data.Naive
import HaskellWorks.Data.Positioning

closeAt' :: (TestBit a, BitLength a) => a -> Count -> Bool
closeAt' :: forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt' a
v Count
c = Count
c forall a. Ord a => a -> a -> Bool
> Count
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (a
v forall a. TestBit a => a -> Position -> Bool
.?. forall a. ToPosition a => a -> Position
toPosition (Count
c forall a. Num a => a -> a -> a
- Count
1)) Bool -> Bool -> Bool
|| Count
c forall a. Ord a => a -> a -> Bool
> forall v. BitLength v => v -> Count
bitLength a
v
{-# INLINE closeAt' #-}

class CloseAt v where
  -- | Determine if the parenthesis at the give position (one-based) is a close.
  --
  -- >>> :set -XTypeApplications
  -- >>> import HaskellWorks.Data.Bits.BitRead
  -- >>> import Data.Maybe
  --
  -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 1
  -- False
  --
  -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 2
  -- True
  --
  -- If the parenthesis at the given position does not exist in the input, it is considered to be a close.
  --
  -- >>> closeAt (fromJust $ bitRead @Word8 "10101010") 9
  -- True
  closeAt :: v -> Count -> Bool

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

instance CloseAt [Bool] where
  closeAt :: [Bool] -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}

instance CloseAt (DVS.Vector Word8) where
  closeAt :: Vector Word8 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}


instance CloseAt (DVS.Vector Word16) where
  closeAt :: Vector Word16 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}


instance CloseAt (DVS.Vector Word32) where
  closeAt :: Vector Word32 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}


instance CloseAt (DVS.Vector Word64) where
  closeAt :: Vector Count -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}


instance CloseAt Word8 where
  closeAt :: Word8 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}

instance CloseAt Word16 where
  closeAt :: Word16 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}

instance CloseAt Word32 where
  closeAt :: Word32 -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}

instance CloseAt Word64 where
  closeAt :: Count -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt     #-}

instance CloseAt (Naive Word64) where
  closeAt :: Naive Count -> Count -> Bool
closeAt = forall a. (TestBit a, BitLength a) => a -> Count -> Bool
closeAt'
  {-# INLINE closeAt #-}

instance CloseAt (Broadword Word64) where
  closeAt :: Broadword Count -> Count -> Bool
closeAt = forall v. CloseAt v => v -> Count -> Bool
closeAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Broadword Count -> Count
broadword
  {-# INLINE closeAt #-}