{-# LANGUAGE FlexibleInstances #-}

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

import Data.Word
import HaskellWorks.Data.BalancedParens.CloseAt
import HaskellWorks.Data.BalancedParens.FindCloseN
import HaskellWorks.Data.Bits.BitShown
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Bits.Broadword.Type
import HaskellWorks.Data.Naive
import HaskellWorks.Data.Positioning

import qualified Data.Vector.Storable                                                   as DVS
import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector16 as BWV16
import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector32 as BWV32
import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector64 as BWV64
import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.FindClose.Vector8  as BWV8
import qualified HaskellWorks.Data.BalancedParens.Internal.Broadword.Word64             as W64

class FindClose v where
  -- | Find the closing parenthesis that machines the open parenthesis at the current position.
  --
  -- If the parenthesis at the current position is an close parenthesis, then return the current position.
  --
  -- Indexes are 1-based.  1 corresponds to open and 0 corresponds to close.
  --
  -- If we run out of bits in the supplied bit-string, the implementation my either return Nothing, or
  -- assume all the bits that follow are zeros.
  --
  -- >>> :set -XTypeApplications
  -- >>> import Data.Maybe
  -- >>> import HaskellWorks.Data.Bits.BitRead
  -- >>> findClose (fromJust (bitRead @Word64 "00000000")) 1
  -- Just 1
  -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 1
  -- Just 2
  -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 2
  -- Just 2
  -- >>> findClose (fromJust (bitRead @Word64 "10101010")) 3
  -- Just 4
  -- >>> findClose (fromJust (bitRead @Word64 "11010010")) 1
  -- Just 6
  -- >>> findClose (fromJust (bitRead @Word64 "11110000")) 1
  -- Just 8
  findClose :: v -> Count -> Maybe Count

instance (FindClose a) => FindClose (BitShown a) where
  findClose :: BitShown a -> Count -> Maybe Count
findClose = forall v. FindClose v => v -> Count -> Maybe Count
findClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BitShown a -> a
bitShown
  {-# INLINE findClose #-}

instance FindClose [Bool] where
  findClose :: [Bool] -> Count -> Maybe Count
findClose [Bool]
v Count
p = if [Bool]
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN [Bool]
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose (DVS.Vector Word8) where
  findClose :: Vector Word8 -> Count -> Maybe Count
findClose = Vector Word8 -> Count -> Maybe Count
BWV8.findClose
  {-# INLINE findClose #-}

instance FindClose (DVS.Vector Word16) where
  findClose :: Vector Word16 -> Count -> Maybe Count
findClose = Vector Word16 -> Count -> Maybe Count
BWV16.findClose
  {-# INLINE findClose #-}

instance FindClose (DVS.Vector Word32) where
  findClose :: Vector Word32 -> Count -> Maybe Count
findClose = Vector Word32 -> Count -> Maybe Count
BWV32.findClose
  {-# INLINE findClose #-}

instance FindClose (DVS.Vector Word64) where
  findClose :: Vector Count -> Count -> Maybe Count
findClose = Vector Count -> Count -> Maybe Count
BWV64.findClose
  {-# INLINE findClose #-}

instance FindClose (Naive (DVS.Vector Word8)) where
  findClose :: Naive (Vector Word8) -> Count -> Maybe Count
findClose (Naive Vector Word8
v) Count
p = if Vector Word8
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Vector Word8
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose (Naive (DVS.Vector Word16)) where
  findClose :: Naive (Vector Word16) -> Count -> Maybe Count
findClose (Naive Vector Word16
v) Count
p = if Vector Word16
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Vector Word16
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose (Naive (DVS.Vector Word32)) where
  findClose :: Naive (Vector Word32) -> Count -> Maybe Count
findClose (Naive Vector Word32
v) Count
p = if Vector Word32
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Vector Word32
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose (Naive (DVS.Vector Word64)) where
  findClose :: Naive (Vector Count) -> Count -> Maybe Count
findClose (Naive Vector Count
v) Count
p = if Vector Count
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Vector Count
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose Word8 where
  findClose :: Word8 -> Count -> Maybe Count
findClose Word8
v Count
p = if Word8
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Word8
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose Word16 where
  findClose :: Word16 -> Count -> Maybe Count
findClose Word16
v Count
p = if Word16
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Word16
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose Word32 where
  findClose :: Word32 -> Count -> Maybe Count
findClose Word32
v Count
p = if Word32
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Word32
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose Word64 where
  findClose :: Count -> Count -> Maybe Count
findClose = forall v. FindClose v => v -> Count -> Maybe Count
findClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Broadword a
Broadword
  {-# INLINE findClose #-}

instance FindClose (Naive Word64) where
  findClose :: Naive Count -> Count -> Maybe Count
findClose Naive Count
v Count
p = if Naive Count
v forall v. CloseAt v => v -> Count -> Bool
`closeAt` Count
p then forall a. a -> Maybe a
Just Count
p else forall v. FindCloseN v => v -> Count -> Count -> Maybe Count
findCloseN Naive Count
v Count
1 (Count
p forall a. Num a => a -> a -> a
+ Count
1)
  {-# INLINE findClose #-}

instance FindClose (Broadword Word64) where
  findClose :: Broadword Count -> Count -> Maybe Count
findClose (Broadword Count
w) Count
p = let x :: Count
x = Count
w forall a. Shift a => a -> Count -> a
.>. (Count
p forall a. Num a => a -> a -> a
- Count
1) in
    case forall a. Num a => a -> a
negate (Count
x forall a. BitWise a => a -> a -> a
.&. Count
1) forall a. BitWise a => a -> a -> a
.&. Count -> Count
W64.findUnmatchedClose Count
x of
      Count
127 -> forall a. Maybe a
Nothing
      Count
r   -> let r' :: Count
r' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
r forall a. Num a => a -> a -> a
+ Count
p in if Count
r' forall a. Ord a => a -> a -> Bool
> Count
64 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Count
r'
  {-# INLINE findClose #-}