module SocketActivation.Parsing where

import           Control.Monad             (Functor (fmap), Monad (return),
                                            (>=>))
import           Data.Bits                 (toIntegralSized)
import           Data.Function             ((.))
import           Data.Maybe                (Maybe)
import           Data.Text                 (Text)
import           Foreign.C.Types           (CInt)
import           Numeric.Natural           (Natural)
import           Text.Read                 (readMaybe)

import qualified Data.Text                 as Text

import           SocketActivation.Concepts

readRecipient :: Text -> Maybe Recipient
readRecipient :: Text -> Maybe Recipient
readRecipient = Text -> Maybe ProcessID
read (Text -> Maybe ProcessID)
-> (ProcessID -> Maybe Recipient) -> Text -> Maybe Recipient
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ProcessID -> Maybe Recipient
wrap
  where
    read :: Text -> Maybe ProcessID
read = Read ProcessID => String -> Maybe ProcessID
forall a. Read a => String -> Maybe a
readMaybe @ProcessID (String -> Maybe ProcessID)
-> (Text -> String) -> Text -> Maybe ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
    wrap :: ProcessID -> Maybe Recipient
wrap = Recipient -> Maybe Recipient
forall (m :: * -> *) a. Monad m => a -> m a
return (Recipient -> Maybe Recipient)
-> (ProcessID -> Recipient) -> ProcessID -> Maybe Recipient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> Recipient
RecipientPID

readCount :: Text -> Maybe Count
readCount :: Text -> Maybe Count
readCount = Text -> Maybe CInt
read (Text -> Maybe CInt)
-> (CInt -> Maybe Count) -> Text -> Maybe Count
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CInt -> Maybe Natural
convert (CInt -> Maybe Natural)
-> (Natural -> Maybe Count) -> CInt -> Maybe Count
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Natural -> Maybe Count
wrap
  where
    read :: Text -> Maybe CInt
read = Read CInt => String -> Maybe CInt
forall a. Read a => String -> Maybe a
readMaybe @CInt (String -> Maybe CInt) -> (Text -> String) -> Text -> Maybe CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
    convert :: CInt -> Maybe Natural
convert = CInt -> Maybe Natural
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized :: CInt -> Maybe Natural
    wrap :: Natural -> Maybe Count
wrap = Count -> Maybe Count
forall (m :: * -> *) a. Monad m => a -> m a
return (Count -> Maybe Count)
-> (Natural -> Count) -> Natural -> Maybe Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Count
CountNat

readNames :: Text -> Names
readNames :: Text -> Names
readNames = [Name] -> Names
NamesList ([Name] -> Names) -> (Text -> [Name]) -> Text -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Name) -> [Text] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Name
NameText ([Text] -> [Name]) -> (Text -> [Text]) -> Text -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
":"