{-# LANGUAGE CPP          #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Unsafe       #-}
#endif

{-# OPTIONS_HADDOCK hide #-}

-- | Module      : Data.UUID.Types.Internal.Builder
-- Copyright   : (c) 2009 Mark Lentczner
--
-- License     : BSD-style
--
-- Maintainer  : markl@glyphic.com
-- Stability   : experimental
-- Portability : portable
--
-- This module provides a system that can call a function that takes
-- a sequence of some number of Word8 arguments.
--
-- The twist is that the Word8 arguments can be supplied directly
-- from Word8s, or from other sources that may provide more than
-- one Word8 apiece. Examples are Word16 and Word32 that supply
-- two and four Word8s respectively. Other ByteSource instances
-- can be defined.
--
-- This module is admittedly overkill. There are only three places
-- in the uuid package that need to call buildFromBytes with 16
-- Word8 values, but each place uses Words of different lengths:
--      version 1 uuids: 32-16-16-16-8-8-8-8-8-8
--      version 4 uuids: 24-24-32-24-24
--      version 5 uuids: 32-32-32-32
-- Originally, these three constructions were hand coded but the
-- code was ungainly. Using this module makes the code very
-- concise, and turns out to optimize to just as fast, or faster!

module Data.UUID.Types.Internal.Builder
    (ByteSource(..)
    ,ByteSink
    ,Takes1Byte
    ,Takes2Bytes
    ,Takes3Bytes
    ,Takes4Bytes
    ) where

import Data.Bits
import Data.Word



type Takes1Byte  g = Word8 -> g
type Takes2Bytes g = Word8 -> Word8 -> g
type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g
type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g
type Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> g

-- | Type of function that a given ByteSource needs.
-- This function must take as many Word8 arguments as the ByteSource provides
type family ByteSink w g
type instance ByteSink Word8  g = Takes1Byte g
type instance ByteSink Word16 g = Takes2Bytes g
type instance ByteSink Word32 g = Takes4Bytes g
type instance ByteSink Word64 g = Takes8Bytes g
type instance ByteSink Int    g = Takes4Bytes g


-- | Class of types that can add Word8s to a Builder.
-- Instances for Word8, Word16, Word32 and Int provide 1, 2, 4 and 4 bytes,
-- respectively, into a ByteSink
class ByteSource w where
    -- | Apply the source's bytes to the sink
    (/-/) :: ByteSink w g -> w -> g

infixl 6 /-/

instance ByteSource Word8 where
    ByteSink Word8 g
f /-/ :: forall g. ByteSink Word8 g -> Word8 -> g
/-/ Word8
w = ByteSink Word8 g
f Word8
w

instance ByteSource Word16 where
    ByteSink Word16 g
f /-/ :: forall g. ByteSink Word16 g -> Word16 -> g
/-/ Word16
w = ByteSink Word16 g
f Word8
b1 Word8
b2
        where b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
              b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w

instance ByteSource Word32 where
    ByteSink Word32 g
f /-/ :: forall g. ByteSink Word32 g -> Word32 -> g
/-/ Word32
w = ByteSink Word32 g
f Word8
b1 Word8
b2 Word8
b3 Word8
b4
        where b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
              b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
              b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
              b4 :: Word8
b4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w

instance ByteSource Word64 where
    ByteSink Word64 g
f /-/ :: forall g. ByteSink Word64 g -> Word64 -> g
/-/ Word64
w = ByteSink Word64 g
f Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 Word8
b8
        where b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
56)
              b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
              b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
              b4 :: Word8
b4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
              b5 :: Word8
b5 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
              b6 :: Word8
b6 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
              b7 :: Word8
b7 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
              b8 :: Word8
b8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w

instance ByteSource Int where
    ByteSink Int g
f /-/ :: forall g. ByteSink Int g -> Int -> g
/-/ Int
w = ByteSink Int g
f Word8
b1 Word8
b2 Word8
b3 Word8
b4
        where b1 :: Word8
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
              b2 :: Word8
b2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
              b3 :: Word8
b3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
              b4 :: Word8
b4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w