module HaskellWorks.Data.Network.Ip.Internal.Appar
  ( fourOctetsToWord32
  , (#<*>#)
  , octet
  , whitespace
  , ipv4Address
  , ipv4NetMask
  , digit
  , digits
  , ipv4Block
  , word32x4ToWords
  , bitPower
  , blockSize
  , bitPower128
  , blockSize128
  , readsPrecOnParser
  ) where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Word
import HaskellWorks.Data.Bits.BitWise

import qualified Text.Appar.String as AP

fourOctetsToWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
fourOctetsToWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
fourOctetsToWord32 Word8
a Word8
b Word8
c Word8
d =
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<. Count
24) Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<. Count
16) Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<.  Count
8) Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|.
   Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
{-# INLINE fourOctetsToWord32 #-}

infixl 4 #<*>#

(#<*>#) :: AP.Parser Word8 -> AP.Parser Word8 -> AP.Parser Word8
#<*># :: Parser Word8 -> Parser Word8 -> Parser Word8
(#<*>#) Parser Word8
pa Parser Word8
pb = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
paste (Word8 -> Word8 -> Word8)
-> Parser Word8 -> MkParser String (Word8 -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
pa MkParser String (Word8 -> Word8) -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
pb
  where paste :: a -> a -> a
paste a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b

octet :: AP.Parser Word8
octet :: Parser Word8
octet = Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try ((Int -> Int -> Parser Word8
digits Int
1 Int
2 Parser Word8 -> Parser Word8 -> Parser Word8
#<*>#  Int -> Parser Word8
digit Int
5  ) Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
5)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>   Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try ((Int -> Int -> Parser Word8
digits Int
1 Int
2 Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
4) Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>   Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try (( Int -> Parser Word8
digit Int
1   Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9) Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>   Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try ( Int -> Int -> Parser Word8
digits Int
1 Int
9 Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>            Int -> Int -> Parser Word8
digits Int
0 Int
9

whitespace :: AP.Parser ()
whitespace :: Parser ()
whitespace = MkParser String String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MkParser String String -> Parser ())
-> MkParser String String -> Parser ()
forall a b. (a -> b) -> a -> b
$ MkParser String Char -> MkParser String String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> MkParser String Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
AP.satisfy Char -> Bool
isSpace)

ipv4Address :: AP.Parser Word32
ipv4Address :: Parser Word32
ipv4Address = Word8 -> Word8 -> Word8 -> Word8 -> Word32
fourOctetsToWord32
  (Word8 -> Word8 -> Word8 -> Word8 -> Word32)
-> Parser Word8
-> MkParser String (Word8 -> Word8 -> Word8 -> Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Word8
octet Parser Word8 -> MkParser String Char -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
AP.char Char
'.')
  MkParser String (Word8 -> Word8 -> Word8 -> Word32)
-> Parser Word8 -> MkParser String (Word8 -> Word8 -> Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Word8
octet Parser Word8 -> MkParser String Char -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
AP.char Char
'.')
  MkParser String (Word8 -> Word8 -> Word32)
-> Parser Word8 -> MkParser String (Word8 -> Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Word8
octet Parser Word8 -> MkParser String Char -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
AP.char Char
'.')
  MkParser String (Word8 -> Word32) -> Parser Word8 -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Parser Word8
octet

ipv4NetMask :: AP.Parser Word8
ipv4NetMask :: Parser Word8
ipv4NetMask =  Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try (Int -> Parser Word8
digit Int
3   Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
2)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>          Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try (Int -> Parser Word8
digit Int
2   Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>          Parser Word8 -> Parser Word8
forall inp a. MkParser inp a -> MkParser inp a
AP.try (Int -> Parser Word8
digit Int
1   Parser Word8 -> Parser Word8 -> Parser Word8
#<*># Int -> Int -> Parser Word8
digits Int
0 Int
9)
  Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>           Int -> Int -> Parser Word8
digits Int
0 Int
9

digit :: Int -> AP.Parser Word8
digit :: Int -> Parser Word8
digit Int
c      = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (-Int
48)) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> MkParser String Char -> Parser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> MkParser String Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
AP.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Char
chr (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48))

digits :: Int -> Int -> AP.Parser Word8
digits :: Int -> Int -> Parser Word8
digits Int
c1 Int
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (-Int
48)) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> MkParser String Char -> Parser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> MkParser String Char
forall inp. Input inp => (Char -> Bool) -> MkParser inp Char
AP.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Char
chr (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Char
chr (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48))

ipv4Block :: AP.Parser (Word32, Word8)
ipv4Block :: Parser (Word32, Word8)
ipv4Block = do
  Word32
addr <- Parser Word32
ipv4Address
  Char
_    <- Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
AP.char Char
'/'
  Word8
mask <- Parser Word8
ipv4NetMask
  (Word32, Word8) -> Parser (Word32, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
addr, Word8
mask)

word32x4ToWords :: (Word32, Word32, Word32, Word32) -> [Word32]
word32x4ToWords :: (Word32, Word32, Word32, Word32) -> [Word32]
word32x4ToWords (Word32
a, Word32
b, Word32
c, Word32
d) = [Word32
a, Word32
b, Word32
c, Word32
d]

bitPower :: Word8 -> Word64
bitPower :: Word8 -> Count
bitPower Word8
m = Word8 -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
32 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
m)

blockSize :: Word8 -> Int
blockSize :: Word8 -> Int
blockSize Word8
m = Int
2 Int -> Count -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8 -> Count
bitPower Word8
m

bitPower128 :: Word8 -> Integer
bitPower128 :: Word8 -> Integer
bitPower128 Word8
m = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
128 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
m)

blockSize128 :: Word8 -> Integer
blockSize128 :: Word8 -> Integer
blockSize128 Word8
m = Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8 -> Integer
bitPower128 Word8
m

readsPrecOnParser :: AP.Parser a -> Int -> String -> [(a, String)]
readsPrecOnParser :: Parser a -> Int -> String -> [(a, String)]
readsPrecOnParser Parser a
p Int
_ String
s = case Parser a -> String -> (Maybe a, String)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
AP.runParser (Parser ()
whitespace Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p) String
s of
    (Just a
a, String
r) -> [(a
a, String
r)]
    (Maybe a, String)
_           -> []