-- | Various utilities used in the network protocol stack modules
module Net.Utils where

import Net.Concurrent
import Net.Bits
import Data.List(unfoldr)
import Data.Array.IArray

--class Functor f => Sequence f where sequence :: Monad m => f (m a) -> m (f a)
class Functor f => Container f where contents :: f a -> a

replace :: f a -> b -> f b
replace f a
x b
b = (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> a -> b
forall a b. a -> b -> a
const b
b) f a
x

emap :: (t -> f a) -> f t -> f (f a)
emap t -> f a
f f t
p= (a -> f a) -> f a -> f (f a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f t -> a -> f a
forall {f :: * -> *} {a} {b}. Functor f => f a -> b -> f b
replace f t
p) (t -> f a
f (f t -> t
forall a. f a -> a
forall (f :: * -> *) a. Container f => f a -> a
contents f t
p))
emap2 :: (t -> f a) -> f (f t) -> f (f (f a))
emap2 t -> f a
f = (f t -> f (f a)) -> f (f t) -> f (f (f a))
forall {f :: * -> *} {f :: * -> *} {t} {a}.
(Functor f, Container f) =>
(t -> f a) -> f t -> f (f a)
emap ((t -> f a) -> f t -> f (f a)
forall {f :: * -> *} {f :: * -> *} {t} {a}.
(Functor f, Container f) =>
(t -> f a) -> f t -> f (f a)
emap t -> f a
f)

lift :: f (f a) -> f (f a)
lift f (f a)
p = (a -> f a) -> f a -> f (f a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f (f a) -> a -> f a
forall {f :: * -> *} {a} {b}. Functor f => f a -> b -> f b
replace f (f a)
p) (f (f a) -> f a
forall a. f a -> a
forall (f :: * -> *) a. Container f => f a -> a
contents f (f a)
p)
lift2 :: f (f (f a)) -> f (f (f a))
lift2 f (f (f a))
p = f (f (f a)) -> f (f (f a))
forall {f :: * -> *} {f :: * -> *} {a}.
(Functor f, Container f) =>
f (f a) -> f (f a)
lift ((f (f a) -> f (f a)) -> f (f (f a)) -> f (f (f a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (f a) -> f (f a)
forall {f :: * -> *} {f :: * -> *} {a}.
(Functor f, Container f) =>
f (f a) -> f (f a)
lift f (f (f a))
p)

-------------------------------------------------------------------------------

doReq :: c a -> ((b -> io ()) -> a) -> m b
doReq c a
reqChan (b -> io ()) -> a
req =
   do v b
ans <- m (v b)
forall a. m (v a)
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => io (v a)
newEmptyMVar
      c a -> a -> m ()
forall a. c a -> a -> m ()
forall (c :: * -> *) (io :: * -> *) a.
ChannelIO c io =>
c a -> a -> io ()
writeChan c a
reqChan ((b -> io ()) -> a
req (v b -> b -> io ()
forall a. v a -> a -> io ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v b
ans))
      v b -> m b
forall a. v a -> m a
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => v a -> io a
takeMVar v b
ans

{- -- If there is a timeout, m is still completed and the result is ignored...
timeout t m =
  do c <- newChan
     fork $ do delay t ; writeChan c Nothing
     fork $ writeChan c . Just =<< m
     readChan c
-}
--------------------------------------------------------------------------------

foldlArray             :: (IArray arr elem, Ix ix, Enum ix)
                       => arr ix elem -> (elem -> a -> a) -> a -> a
foldlArray :: forall (arr :: * -> * -> *) elem ix a.
(IArray arr elem, Ix ix, Enum ix) =>
arr ix elem -> (elem -> a -> a) -> a -> a
foldlArray arr ix elem
arr elem -> a -> a
add a
zero = ix -> a -> a
loop ix
min a
zero
  where
  (ix
min,ix
max)             = arr ix elem -> (ix, ix)
forall i. Ix i => arr i elem -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds arr ix elem
arr
  loop :: ix -> a -> a
loop ix
ix a
tot
    | ix
ix ix -> ix -> Bool
forall a. Ord a => a -> a -> Bool
<= ix
max         = ix -> a -> a
loop (ix -> ix
forall a. Enum a => a -> a
succ ix
ix) (elem -> a -> a
add (arr ix elem
arr arr ix elem -> ix -> elem
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ix
ix) a
tot)
    | Bool
otherwise         = a
tot

-- | The number of elements in an array
arraySize :: a a e -> a
arraySize a a e
a             = a
max a -> a -> a
forall a. Num a => a -> a -> a
- a
min a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
  where
  (a
min,a
max)             = a a e -> (a, a)
forall i. Ix i => a i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a a e
a


{-
checksum               :: (IArray arr Word16, Ix ix, Enum ix) => arr ix Word16 -> Word16
checksum arr            = let total   = foldlArray arr add (0 :: Word32)
                              add x t = fromIntegral x + t
                          in complement ((total .!. 1) + (total .!. 0))
-}


-- | TCP\/IP 16-bit checksums
checksum                 :: [Word16] -> Word16
checksum :: [Word16] -> Word16
checksum [Word16]
ws               = let total :: Word32
total = [Word32] -> Word32
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Word16 -> Word32) -> [Word16] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word16]
ws) :: Word32
                            in Word16 -> Word16
forall a. Bits a => a -> a
complement (Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
total Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
total Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16))



-- | Split a list into subcomponents of length 2.
-- The first argument is what to append in case the list is of odd length.
pairs                    :: a -> [a] -> [[a]]
pairs :: forall a. a -> [a] -> [[a]]
pairs a
a                   = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [a] -> Maybe ([a], [a])
mk
  where
  mk :: [a] -> Maybe ([a], [a])
mk (a
x:a
y:[a]
zs)             = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([a
x,a
y],[a]
zs)
  mk [a
x]                  = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([a
x,a
a],[])
  mk []                   = Maybe ([a], [a])
forall a. Maybe a
Nothing


bytes_to_words_big       :: [Word8] -> [Word16]
bytes_to_words_big :: [Word8] -> [Word16]
bytes_to_words_big        = ([Word8] -> Word16) -> [[Word8]] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> Word16
forall {a} {t}.
(Integral a, Num t, FiniteBits a, Bits t) =>
[a] -> t
catBits ([[Word8]] -> [Word16])
-> ([Word8] -> [[Word8]]) -> [Word8] -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> [Word8] -> [[Word8]]
forall a. a -> [a] -> [[a]]
pairs Word8
0

bytes_to_words_lil       :: [Word8] -> [Word16]
bytes_to_words_lil :: [Word8] -> [Word16]
bytes_to_words_lil        = ([Word8] -> Word16) -> [[Word8]] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map ([Word8] -> Word16
forall {a} {t}.
(Integral a, Num t, FiniteBits a, Bits t) =>
[a] -> t
catBits ([Word8] -> Word16) -> ([Word8] -> [Word8]) -> [Word8] -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse) ([[Word8]] -> [Word16])
-> ([Word8] -> [[Word8]]) -> [Word8] -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> [Word8] -> [[Word8]]
forall a. a -> [a] -> [[a]]
pairs Word8
0

words_to_bytes_big       :: [Word16] -> [Word8]
words_to_bytes_big :: [Word16] -> [Word8]
words_to_bytes_big [Word16]
ws     = [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Word16
w Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, Word16
w Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0] | Word16
w <- [Word16]
ws ]

words_to_bytes_lil       :: [Word16] -> [Word8]
words_to_bytes_lil :: [Word16] -> [Word8]
words_to_bytes_lil [Word16]
ws     = [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Word16
w Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0, Word16
w Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1] | Word16
w <- [Word16]
ws ]