module Ptr.Poking
where
import Ptr.Prelude hiding (length)
import qualified Ptr.IO as A
import qualified Ptr.Poke as C
import qualified Ptr.PokeAndPeek as D
import qualified Ptr.PokeIO as E
import qualified Ptr.List as List
import qualified Data.ByteString.Internal as B
import qualified Data.Vector as F
import qualified Data.Vector.Generic as GenericVector
import qualified Data.List as List
data Poking =
Poking !Int (Ptr Word8 -> IO ())
instance Semigroup Poking where
{-# INLINABLE (<>) #-}
<> :: Poking -> Poking -> Poking
(<>) (Poking Int
space1 Ptr Word8 -> IO ()
action1) (Poking Int
space2 Ptr Word8 -> IO ()
action2) =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking (Int
space1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space2) Ptr Word8 -> IO ()
action
where
action :: Ptr Word8 -> IO ()
action =
if Int
space1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2048 Bool -> Bool -> Bool
|| Int
space2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2048
then Int
-> (Ptr Word8 -> IO ())
-> (Ptr Word8 -> IO ())
-> Ptr Word8
-> IO ()
E.sequentially Int
space1 Ptr Word8 -> IO ()
action1 Ptr Word8 -> IO ()
action2
else Int
-> (Ptr Word8 -> IO ())
-> (Ptr Word8 -> IO ())
-> Ptr Word8
-> IO ()
E.concurrently Int
space1 Ptr Word8 -> IO ()
action1 Ptr Word8 -> IO ()
action2
instance Monoid Poking where
{-# INLINE mempty #-}
mempty :: Poking
mempty =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
0 (IO () -> Ptr Word8 -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
{-# INLINE mappend #-}
mappend :: Poking -> Poking -> Poking
mappend =
Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
(<>)
instance IsString Poking where
fromString :: String -> Poking
fromString String
string = Int -> (Ptr Word8 -> IO ()) -> Poking
Poking (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length String
string) Ptr Word8 -> IO ()
io where
io :: Ptr Word8 -> IO ()
io Ptr Word8
ptr = (Ptr Word8 -> Char -> IO (Ptr Word8))
-> Ptr Word8 -> String -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Ptr Word8 -> Char -> IO (Ptr Word8)
forall b. Ptr Word8 -> Char -> IO (Ptr b)
step Ptr Word8
ptr String
string where
step :: Ptr Word8 -> Char -> IO (Ptr b)
step Ptr Word8
ptr Char
char = Ptr Word8 -> Word8 -> IO ()
A.pokeWord8 Ptr Word8
ptr (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
char)) IO () -> Ptr b -> IO (Ptr b)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
{-# INLINE null #-}
null :: Poking -> Bool
null :: Poking -> Bool
null =
(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Poking -> Int) -> Poking -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Poking -> Int
length
{-# INLINE length #-}
length :: Poking -> Int
length :: Poking -> Int
length (Poking Int
size Ptr Word8 -> IO ()
_) =
Int
size
{-# INLINE word8 #-}
word8 :: Word8 -> Poking
word8 :: Word8 -> Poking
word8 Word8
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
1 ((Ptr Word8 -> Word8 -> IO ()) -> Word8 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word8 -> IO ()
A.pokeWord8 Word8
x)
{-# INLINE leWord16 #-}
leWord16 :: Word16 -> Poking
leWord16 :: Word16 -> Poking
leWord16 Word16
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
2 ((Ptr Word8 -> Word16 -> IO ()) -> Word16 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word16 -> IO ()
A.pokeLEWord16 Word16
x)
{-# INLINE leWord32 #-}
leWord32 :: Word32 -> Poking
leWord32 :: Word32 -> Poking
leWord32 Word32
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
4 ((Ptr Word8 -> Word32 -> IO ()) -> Word32 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word32 -> IO ()
A.pokeLEWord32 Word32
x)
{-# INLINE leWord64 #-}
leWord64 :: Word64 -> Poking
leWord64 :: Word64 -> Poking
leWord64 Word64
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
8 ((Ptr Word8 -> Word64 -> IO ()) -> Word64 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word64 -> IO ()
A.pokeLEWord64 Word64
x)
{-# INLINE beWord16 #-}
beWord16 :: Word16 -> Poking
beWord16 :: Word16 -> Poking
beWord16 Word16
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
2 ((Ptr Word8 -> Word16 -> IO ()) -> Word16 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word16 -> IO ()
A.pokeBEWord16 Word16
x)
{-# INLINE beWord32 #-}
beWord32 :: Word32 -> Poking
beWord32 :: Word32 -> Poking
beWord32 Word32
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
4 ((Ptr Word8 -> Word32 -> IO ()) -> Word32 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word32 -> IO ()
A.pokeBEWord32 Word32
x)
{-# INLINE beWord64 #-}
beWord64 :: Word64 -> Poking
beWord64 :: Word64 -> Poking
beWord64 Word64
x =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
8 ((Ptr Word8 -> Word64 -> IO ()) -> Word64 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word64 -> IO ()
A.pokeBEWord64 Word64
x)
{-# INLINE bytes #-}
bytes :: ByteString -> Poking
bytes :: ByteString -> Poking
bytes (B.PS ForeignPtr Word8
bytesFPtr Int
offset Int
length) =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
length (\Ptr Word8
ptr -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bytesFPtr (\Ptr Word8
bytesPtr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bytesPtr Int
offset) Int
length))
{-# INLINE poke #-}
poke :: C.Poke input -> input -> Poking
poke :: Poke input -> input -> Poking
poke (C.Poke Int
space Ptr Word8 -> input -> IO ()
poke) input
input =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
space (\Ptr Word8
ptr -> Ptr Word8 -> input -> IO ()
poke Ptr Word8
ptr input
input)
{-# INLINE pokeAndPeek #-}
pokeAndPeek :: D.PokeAndPeek input output -> input -> Poking
pokeAndPeek :: PokeAndPeek input output -> input -> Poking
pokeAndPeek (D.PokeAndPeek Int
space Ptr Word8 -> input -> IO ()
poke Ptr Word8 -> IO output
_) input
input =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
space (\Ptr Word8
ptr -> Ptr Word8 -> input -> IO ()
poke Ptr Word8
ptr input
input)
{-# INLINE asciiIntegral #-}
asciiIntegral :: (Integral a) => a -> Poking
asciiIntegral :: a -> Poking
asciiIntegral = \ case
a
0 -> Word8 -> Poking
word8 Word8
48
a
x -> let
reverseDigits :: [a]
reverseDigits = a -> a -> [a]
forall a. Integral a => a -> a -> [a]
List.reverseDigits a
10 a
x
size :: Int
size = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
reverseDigits
action :: Ptr Word8 -> IO ()
action = Int -> [a] -> Ptr Word8 -> IO ()
forall a. Integral a => Int -> [a] -> Ptr Word8 -> IO ()
E.reverseAsciiDigits (Int -> Int
forall a. Enum a => a -> a
pred Int
size) [a]
reverseDigits
in Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
size Ptr Word8 -> IO ()
action
{-# INLINE asciiChar #-}
asciiChar :: Char -> Poking
asciiChar :: Char -> Poking
asciiChar =
Word8 -> Poking
word8 (Word8 -> Poking) -> (Char -> Word8) -> Char -> Poking
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord
{-# INLINABLE asciiPaddedAndTrimmedIntegral #-}
asciiPaddedAndTrimmedIntegral :: Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral :: Int -> a -> Poking
asciiPaddedAndTrimmedIntegral !Int
length !a
integral =
if Int
length Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then
if a
integral a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
then case a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
integral a
10 of
(a
quot, a
rem) ->
Int -> a -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral (Int -> Int
forall a. Enum a => a -> a
pred Int
length) a
quot Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Word8 -> Poking
word8 (Word8
48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
rem)
else Int -> Poking -> Poking
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
length (Word8 -> Poking
word8 Word8
48)
else Poking
forall a. Monoid a => a
mempty
{-# INLINABLE asciiUtcTimeInIso8601 #-}
asciiUtcTimeInIso8601 :: UTCTime -> Poking
asciiUtcTimeInIso8601 :: UTCTime -> Poking
asciiUtcTimeInIso8601 UTCTime
utcTime =
Int -> Integer -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
4 Integer
year Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
45 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Int -> Int -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
2 Int
month Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
45 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Int -> Int -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
2 Int
day Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Word8 -> Poking
word8 Word8
84 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Int -> Int -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
2 Int
hour Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
58 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Int -> Int -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
2 Int
minute Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
58 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Int -> Integer -> Poking
forall a. Integral a => Int -> a -> Poking
asciiPaddedAndTrimmedIntegral Int
2 (Pico -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Pico
second) Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<>
Word8 -> Poking
word8 Word8
90
where
LocalTime Day
date (TimeOfDay Int
hour Int
minute Pico
second) = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
utcTime
(Integer
year, Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
date
{-# INLINE list #-}
list :: (element -> Poking) -> [element] -> Poking
list :: (element -> Poking) -> [element] -> Poking
list element -> Poking
element =
Poking -> [element] -> Poking
loop Poking
forall a. Monoid a => a
mempty
where
loop :: Poking -> [element] -> Poking
loop Poking
state =
\ case
element
head : [element]
tail -> Poking -> [element] -> Poking
loop (Poking
state Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
1 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> element -> Poking
element element
head) [element]
tail
[element]
_ -> Poking
state Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
word8 Word8
0
{-# INLINABLE vector #-}
vector :: GenericVector.Vector vector element => (element -> Poking) -> vector element -> Poking
vector :: (element -> Poking) -> vector element -> Poking
vector element -> Poking
element vector element
vectorValue =
Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
byteSize Ptr Word8 -> IO ()
io
where
byteSize :: Int
byteSize =
(Int -> element -> Int) -> Int -> vector element -> Int
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
GenericVector.foldl' Int -> element -> Int
step Int
0 vector element
vectorValue
where
step :: Int -> element -> Int
step !Int
byteSize element
elementValue =
case element -> Poking
element element
elementValue of
Poking Int
elementByteSize Ptr Word8 -> IO ()
_ -> Int
byteSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
elementByteSize
io :: Ptr Word8 -> IO ()
io Ptr Word8
ptr =
(Ptr Word8 -> element -> IO (Ptr Word8))
-> Ptr Word8 -> vector element -> IO ()
forall (m :: * -> *) (v :: * -> *) b a.
(Monad m, Vector v b) =>
(a -> b -> m a) -> a -> v b -> m ()
GenericVector.foldM'_ Ptr Word8 -> element -> IO (Ptr Word8)
step Ptr Word8
ptr vector element
vectorValue
where
step :: Ptr Word8 -> element -> IO (Ptr Word8)
step Ptr Word8
ptr element
elementValue =
case element -> Poking
element element
elementValue of
Poking Int
elementByteSize Ptr Word8 -> IO ()
elementIO -> do
Ptr Word8 -> IO ()
elementIO Ptr Word8
ptr
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
elementByteSize)
{-# INLINABLE intercalateVector #-}
intercalateVector :: GenericVector.Vector vector element => (element -> Poking) -> Poking -> vector element -> Poking
intercalateVector :: (element -> Poking) -> Poking -> vector element -> Poking
intercalateVector element -> Poking
element (Poking Int
separatorLength Ptr Word8 -> IO ()
separatorIo) vector element
vectorValue = Int -> (Ptr Word8 -> IO ()) -> Poking
Poking Int
length Ptr Word8 -> IO ()
io where
length :: Int
length = (Int -> element -> Int) -> Int -> vector element -> Int
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
GenericVector.foldl' Int -> element -> Int
step Int
0 vector element
vectorValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((vector element -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
GenericVector.length vector element
vectorValue Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
separatorLength) where
step :: Int -> element -> Int
step Int
length element
elementValue = case element -> Poking
element element
elementValue of
Poking Int
elementLength Ptr Word8 -> IO ()
_ -> Int
length Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
elementLength
indexIsLast :: Int -> Bool
indexIsLast = let
lastIndex :: Int
lastIndex = Int -> Int
forall a. Enum a => a -> a
pred (vector element -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
GenericVector.length vector element
vectorValue)
in (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lastIndex)
io :: Ptr Word8 -> IO ()
io Ptr Word8
ptr = (Ptr Word8 -> Int -> element -> IO (Ptr Word8))
-> Ptr Word8 -> vector element -> IO ()
forall (m :: * -> *) (v :: * -> *) b a.
(Monad m, Vector v b) =>
(a -> Int -> b -> m a) -> a -> v b -> m ()
GenericVector.ifoldM'_ Ptr Word8 -> Int -> element -> IO (Ptr Word8)
step Ptr Word8
ptr vector element
vectorValue where
step :: Ptr Word8 -> Int -> element -> IO (Ptr Word8)
step Ptr Word8
ptr Int
index element
elementValue = case element -> Poking
element element
elementValue of
Poking Int
elementLength Ptr Word8 -> IO ()
elementIo -> if Int -> Bool
indexIsLast Int
index
then Ptr Word8 -> IO ()
elementIo Ptr Word8
ptr IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr
else let
ptrAfterElement :: Ptr Word8
ptrAfterElement = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
elementLength
in Ptr Word8 -> IO ()
elementIo Ptr Word8
ptr IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> IO ()
separatorIo Ptr Word8
ptrAfterElement IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptrAfterElement Int
separatorLength