{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module       : Data.ByteString.Base16.Internal
-- Copyright 	: (c) 2020 Emily Pillmore
-- License	: BSD-style
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: portable
--
-- Internal module defining the encoding and decoding
-- processes and tables.
--
module Data.ByteString.Base16.Internal
( validateBase16
) where


import qualified Data.ByteString as BS
import Data.ByteString.Internal

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable

-- -------------------------------------------------------------------------- --
-- Validating Base16

validateBase16 :: ByteString -> ByteString -> Bool
validateBase16 :: ByteString -> ByteString -> Bool
validateBase16 !ByteString
alphabet (PS fp :: ForeignPtr Word8
fp off :: Int
off l :: Int
l) =
    IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
      Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
off) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off))
  where
    go :: Ptr Word8 -> Ptr Word8 -> IO Bool
go !Ptr Word8
p !Ptr Word8
end
      | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      | Bool
otherwise = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
        if Word8 -> ByteString -> Bool
BS.elem Word8
w ByteString
alphabet
        then Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p 1) Ptr Word8
end
        else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINE validateBase16 #-}