{-# LANGUAGE LambdaCase #-}
module Netw.Internal.Protocols where
import Netw.Internal.Type

import Language.Haskell.TH
import Data.Char (toUpper)

declareProtocols :: Name -> DecsQ
declareProtocols :: Name -> DecsQ
declareProtocols Name
constructor = do
  IO [Protoent] -> Q [Protoent]
forall a. IO a -> Q a
runIO IO [Protoent]
protoents Q [Protoent] -> ([Protoent] -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Protoent -> Q Dec) -> [Protoent] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
    (\ Protoent
proto ->
      do
        Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
patSynD (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
normalize (Protoent -> String
pName Protoent
proto))
                ([Name] -> Q PatSynArgs
forall (m :: * -> *). Quote m => [Name] -> m PatSynArgs
prefixPatSyn [])
                Q PatSynDir
forall (m :: * -> *). Quote m => m PatSynDir
implBidir
                (Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
constructor [Lit -> Q Pat
forall (m :: * -> *). Quote m => Lit -> m Pat
litP (Integer -> Lit
integerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Integer) -> CInt -> Integer
forall a b. (a -> b) -> a -> b
$ Protoent -> CInt
pProto Protoent
proto)]))
  where normalize :: String -> String
normalize =
          let sanitize :: Char -> Char
sanitize = \case Char
'-'  -> Char
'_'
                               Char
'/'  -> Char
'_'
                               Char
'\\' -> Char
'_'
                               Char
' '  -> Char
'_'
                               Char
'+'  -> Char
'p'
                               Char
'.'  -> Char
'_'
                               Char
char -> Char
char
          in  (String
"IPPROTO_"++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char
sanitize (Char -> Char) -> (Char -> Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper)