{-# LANGUAGE Trustworthy, MagicHash, MultiParamTypeClasses, FlexibleInstances #-}
{- |
Module : SDP.ByteString
Copyright : (c) Andrey Mulik 2019
License : BSD-style
Maintainer : work.a.mulik@gmail.com
Portability : non-portable (GHC Extensions)
"SDP.ByteString" provides @sdp@ instances for strict 'ByteString'.
-}
module SDP.ByteString
(
-- * Exports
module System.IO.Classes,
module SDP.Indexed,
module SDP.Sort,
module SDP.Scan,
-- * ByteString
ByteString, SByteString
)
where
import Prelude ()
import SDP.SafePrelude
import SDP.SortM.Tim
import SDP.Indexed
import SDP.Sort
import SDP.Scan
import SDP.Prim.SBytes
import SDP.Bytes.ST
import Data.ByteString.Internal ( unsafeCreate )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import Data.Coerce
import Data.Maybe
import Foreign.Storable ( Storable ( poke ) )
import Foreign.Ptr ( plusPtr )
import Control.Exception.SDP
import System.IO.Classes
default ()
--------------------------------------------------------------------------------
-- | Type synomym to avoid ambiguity.
type SByteString = ByteString
--------------------------------------------------------------------------------
{- Nullable and Estimate instances. -}
instance Nullable ByteString
where
lzero = B.empty
isNull = B.null
instance Estimate ByteString
where
(<==>) = on (<=>) sizeOf
(.<=.) = on (<=) sizeOf
(.>=.) = on (>=) sizeOf
(.>.) = on (>) sizeOf
(.<.) = on (<) sizeOf
(<.=>) = (<=>) . sizeOf
(.>=) = (>=) . sizeOf
(.<=) = (<=) . sizeOf
(.>) = (>) . sizeOf
(.<) = (<) . sizeOf
--------------------------------------------------------------------------------
{- Bordered, Linear and Split instances. -}
instance Bordered ByteString Int
where
lower = const 0
sizeOf = B.length
upper bs = sizeOf bs - 1
bounds bs = (0, sizeOf bs - 1)
indices bs = [0 .. sizeOf bs - 1]
indexIn bs = \ i -> i >= 0 && i < sizeOf bs
instance Linear ByteString Word8
where
single = B.singleton
toHead = B.cons
toLast = B.snoc
head = B.head
tail = B.tail
last = B.last
init = B.init
uncons' = B.uncons
unsnoc' = B.unsnoc
uncons = fromMaybe (pfailEx "uncons") . B.uncons
unsnoc = fromMaybe (pfailEx "unsnoc") . B.unsnoc
fromFoldable es = unsafeCreate (length es) fromFoldable'
where
fromFoldable' ptr = void $ foldr pokeNext (return ptr) es
pokeNext e mp = do p <- mp; poke p e; return $ p `plusPtr` 1
listR = \ bs -> let n = sizeOf bs in [ bs .! i | i <- [n - 1, n - 2 .. 0] ]
listL = B.unpack
(++) = B.append
(!^) = B.index
force = B.copy
write bs = (bs //) . single ... (,)
concat = B.concat . toList
intersperse = B.intersperse
replicate = B.replicate
filter = B.filter
fromList = B.pack
partitions is bs = map fromList . partitions is $ listL bs
isSubseqOf xs ys = B.all (`B.elem` ys) xs
nub bs = runST $ do
hs <- filled 256 False
o_foldr (\ b io -> writeM' hs b True >> io) (return ()) bs
done' hs
where
done' :: STBytes s Word8 Bool -> ST s ByteString
done' = fmap fromList . kfoldrM (\ i b is -> return $ b ? (i : is) $ is) []
nubBy f = fromList . o_foldr (\ b es -> any (f b) es ? es $ b : es) [] . nub
ofoldr f = \ base bs ->
let n = sizeOf bs; go i = n == i ? base $ f i (bs !^ i) (go $ i + 1)
in go 0
ofoldl f = \ base bs ->
let go i = -1 == i ? base $ f i (go $ i + 1) (bs !^ i)
in go (upper bs)
o_foldr = B.foldr
o_foldl = B.foldl
instance Split ByteString Word8
where
take = B.take
drop = B.drop
split = B.splitAt
isPrefixOf = B.isPrefixOf
isSuffixOf = B.isSuffixOf
isInfixOf = B.isInfixOf
takeWhile = B.takeWhile
dropWhile = B.dropWhile
spanl = B.span
spanr = B.spanEnd
breakl = B.break
breakr = B.breakEnd
prefix p = B.foldr (\ e c -> p e ? c + 1 $ 0) 0
suffix p = B.foldl (\ c e -> p e ? c + 1 $ 0) 0
--------------------------------------------------------------------------------
{- Map and Indexed instances. -}
instance Map ByteString Int Word8
where
toMap = toMap' 0
toMap' defvalue ascs = null ascs ? Z $ assoc' (l, u) defvalue ascs
where
l = fst $ minimumBy cmpfst ascs
u = fst $ maximumBy cmpfst ascs
Z // ascs = toMap ascs
es // ascs = assoc (bounds es) (assocs es ++ ascs)
(.!) = B.index
(.$) = B.findIndex
(*$) = B.findIndices
kfoldr = ofoldr
kfoldl = ofoldl
instance Indexed ByteString Int Word8
where
assoc = flip assoc' 0
assoc' bnds defvalue ascs = unsafeCreate n fromAssocIO
where
fromAssocIO ptr = fill >> writeBS
where
writeBS = forM_ ies $ \ (i, e) -> poke (ptr `plusPtr` i) e
fill = forM_ [0 .. n - 1] $ \ i -> poke (ptr `plusPtr` i) defvalue
ies = [ (offset bnds i, e) | (i, e) <- ascs, inRange bnds i ]
n = size bnds
fromIndexed es = let n = sizeOf es in unsafeCreate n $
\ ptr -> forM_ [0 .. n - 1] $ \ i -> poke (ptr `plusPtr` i) (es !^ i)
--------------------------------------------------------------------------------
{- Sort and Scan instances. -}
-- TODO: write counting sort.
instance Sort ByteString Word8
where
sortBy f bs = runST $ do es' <- thaw bs; timSortBy f es'; done es'
sortedBy f = sortedBy f . listL
instance Scan ByteString Word8
--------------------------------------------------------------------------------
{- Thaw and Freeze instances. -}
instance Thaw (ST s) ByteString (STBytes# s Word8) where thaw = fromIndexed'
instance Freeze (ST s) (STBytes# s Word8) ByteString where freeze = done
instance (MonadIO io) => Thaw io ByteString (MIOBytes# io Word8) where thaw = fromIndexed'
instance (MonadIO io) => Freeze io (MIOBytes# io Word8) ByteString where freeze = stToMIO . done . coerce
--------------------------------------------------------------------------------
{- IsFile and IsTextFile instances. -}
instance IsFile ByteString
where
hGetContents = liftIO . B.hGetContents
hPutContents = liftIO ... B.hPut
instance IsTextFile ByteString
where
-- | Print bytestring and CR (0xa) character in Handle encoding.
hPutStrLn h = liftIO . (>> hPutChar h '\n') . hPutStr h
hGetLine = liftIO . B.hGetLine
hPutStr = liftIO ... B.hPut
--------------------------------------------------------------------------------
done :: STBytes# s Word8 -> ST s ByteString
done = fmap fromList . getLeft
pfailEx :: String -> a
pfailEx = throw . PatternMatchFail . showString "in SDP.ByteString.Lazy."