    -- |
    -- Module      : Foundation.Network.IPv4
    -- License     : BSD-style
    -- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
    -- Stability   : experimental
    -- Portability : portable
    --
    -- IPv4 data type
    --
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Foundation.Network.IPv4
        ( IPv4
        , any, loopback
        , fromString, toString
        , fromTuple, toTuple
        , ipv4Parser
        ) where

    import Prelude (fromIntegral,read)

    import Foundation.Class.Storable
    import Foundation.Hashing.Hashable
    import Basement.Compat.Base
    import Data.Proxy
    import Foundation.String (String)
    import Foundation.Primitive
    import Basement.Bits
    import Foundation.Parser hiding (peek)
    import Foundation.Collection (Sequential, Element, elem)

    -- | IPv4 data type
    newtype IPv4 = IPv4 Word32
        deriving (Eq, Ord, Typeable, Hashable)
    instance Show IPv4 where
        show = toLString
    instance NormalForm IPv4 where
        toNormalForm !_ = ()
    instance IsString IPv4 where
        fromString = fromLString
    instance Storable IPv4 where
        peek ptr = IPv4 . fromBE <$> peek (castPtr ptr)
        poke ptr (IPv4 w) = poke (castPtr ptr) (toBE w)
    instance StorableFixed IPv4 where
        size      _ = size      (Proxy :: Proxy Word32)
        alignment _ = alignment (Proxy :: Proxy Word32)

    -- | "0.0.0.0"
    any :: IPv4
    any = fromTuple (0,0,0,0)

    -- | "127.0.0.1"
    loopback :: IPv4
    loopback = fromTuple (127,0,0,1)

    toString :: IPv4 -> String
    toString = fromList . toLString

    fromLString :: [Char] -> IPv4
    fromLString = either throw id . parseOnly ipv4Parser

    toLString :: IPv4 -> [Char]
    toLString ipv4 =
        let (i1, i2, i3, i4) = toTuple ipv4
         in show i1 <> "." <> show i2 <> "." <> show i3 <> "." <> show i4

    fromTuple :: (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple (i1, i2, i3, i4) =
         IPv4 $     (w1 .<<. 24) .&. 0xFF000000
                .|. (w2 .<<. 16) .&. 0x00FF0000
                .|. (w3 .<<.  8) .&. 0x0000FF00
                .|.  w4          .&. 0x000000FF
      where
        f = fromIntegral
        w1, w2, w3, w4 :: Word32
        w1 = f i1
        w2 = f i2
        w3 = f i3
        w4 = f i4

    toTuple :: IPv4 -> (Word8, Word8, Word8, Word8)
    toTuple (IPv4 w) =
        (f w1, f w2, f w3, f w4)
      where
        f = fromIntegral
        w1, w2, w3, w4 :: Word32
        w1 = w .>>. 24 .&. 0x000000FF
        w2 = w .>>. 16 .&. 0x000000FF
        w3 = w .>>.  8 .&. 0x000000FF
        w4 = w         .&. 0x000000FF

    -- | Parse a IPv4 address
    ipv4Parser :: ( ParserSource input, Element input ~ Char
                  , Sequential (Chunk input), Element input ~ Element (Chunk input)
                  )
               => Parser input IPv4
    ipv4Parser = do
        i1 <- takeAWord8 <* element '.'
        i2 <- takeAWord8 <* element '.'
        i3 <- takeAWord8 <* element '.'
        i4 <- takeAWord8
        return $ fromTuple (i1, i2, i3, i4)
      where
        takeAWord8 = read . toList <$> takeWhile isAsciiDecimal
        isAsciiDecimal = flip elem ['0'..'9']