    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Network.Socket.ReadShow where

    import Control.Monad (mzero)
    import Text.Read ((<++))
    import qualified Text.Read as P
    import qualified Text.Read.Lex as P

    -- type alias for individual correspondences of a (possibly partial) bijection
    type Pair a b = (a, b)

    -- | helper function for equality on first tuple element
    {-# INLINE eqFst #-}
    eqFst :: Eq a => a -> (a, b) -> Bool
    eqFst :: forall a b. Eq a => a -> (a, b) -> Bool
    eqFst a
    x = \(a
    x', b
    _) -> a
    x' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x

    -- | helper function for equality on snd tuple element
    {-# INLINE eqSnd #-}
    eqSnd :: Eq b => b -> (a, b) -> Bool
    eqSnd :: forall b a. Eq b => b -> (a, b) -> Bool
    eqSnd b
    y = \(a
    _, b
    y') -> b
    y' b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    y

    -- | Unified automorphic involution over @Either a b@ that converts between
    --   LHS and RHS elements of a list of @Pair a b@ mappings and is the identity
    --   function if no matching pair is found
    --
    --   If list contains duplicate matches, short-circuits to the first matching @Pair@
    lookBetween :: (Eq a, Eq b) => [Pair a b] -> Either a b -> Either a b
    lookBetween :: forall a b. (Eq a, Eq b) => [Pair a b] -> Either a b -> Either a b
    lookBetween [Pair a b]
    ps = \case
        Left a
    x | (a
    _, b
    y) : [Pair a b]
    _ <- (Pair a b -> Bool) -> [Pair a b] -> [Pair a b]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (a -> Pair a b -> Bool
    forall a b. Eq a => a -> (a, b) -> Bool
    eqFst a
    x) [Pair a b]
    ps -> b -> Either a b
    forall a b. b -> Either a b
    Right b
    y
        Right b
    y | (a
    x, b
    _) : [Pair a b]
    _ <- (Pair a b -> Bool) -> [Pair a b] -> [Pair a b]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (b -> Pair a b -> Bool
    forall b a. Eq b => b -> (a, b) -> Bool
    eqSnd b
    y) [Pair a b]
    ps -> a -> Either a b
    forall a b. a -> Either a b
    Left a
    x
        Either a b
    z -> Either a b
    z

    -- Type alias for partial bijections between two types, consisting of a list
    -- of individual correspondences that are checked in order and short-circuit
    -- on first match
    --
    -- Depending on how this is used, may not actually be a true bijection over
    -- the partial types, as no overlap-checking is currently implemented. If
    -- overlaps are unavoidable, the canonical short-circuit pair should appear
    -- first to avoid round-trip inconsistencies.
    type Bijection a b = [Pair a b]

    -- | Helper function for prefixing an optional constructor name before arbitrary values,
    -- which only enforces high precedence on subsequent output if the constructor name is not
    -- blank and space-separates for non-blank constructor names
    namePrefix :: Int -> String -> (Int -> b -> ShowS) -> b -> ShowS
    namePrefix :: forall b. Int -> String -> (Int -> b -> ShowS) -> b -> ShowS
    namePrefix Int
    i String
    name Int -> b -> ShowS
    f b
    x
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    name = Int -> b -> ShowS
    f Int
    i b
    x
        | Bool
    otherwise =
            Bool -> ShowS -> ShowS
    showParen (Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    name ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    ' ' ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> b -> ShowS
    f (Int
    app_prec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) b
    x
    {-# INLINE namePrefix #-}

    -- | Helper function for defining bijective Show instances that represents
    -- a common use-case where a constructor (or constructor-like pattern) name
    -- (optionally) precedes an internal value with a separate show function
    defShow
        :: Eq a => String -> (a -> b) -> (Int -> b -> ShowS) -> (Int -> a -> ShowS)
    defShow :: forall a b.
    Eq a =>
    String -> (a -> b) -> (Int -> b -> ShowS) -> Int -> a -> ShowS
    defShow String
    name a -> b
    unwrap Int -> b -> ShowS
    shoPrec = \Int
    i a
    x -> Int -> String -> (Int -> b -> ShowS) -> b -> ShowS
    forall b. Int -> String -> (Int -> b -> ShowS) -> b -> ShowS
    namePrefix Int
    i String
    name Int -> b -> ShowS
    shoPrec (a -> b
    unwrap a
    x)
    {-# INLINE defShow #-}

    -- Helper function for stripping an optional constructor-name prefix before parsing
    -- an arbitrary value, which only consumes an extra token and increases precedence
    -- if the provided name prefix is non-blank
    expectPrefix :: String -> P.ReadPrec a -> P.ReadPrec a
    expectPrefix :: forall a. String -> ReadPrec a -> ReadPrec a
    expectPrefix String
    name ReadPrec a
    pars
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    name = ReadPrec a
    pars
        | Bool
    otherwise = do
            ReadP () -> ReadPrec ()
    forall a. ReadP a -> ReadPrec a
    P.lift (ReadP () -> ReadPrec ()) -> ReadP () -> ReadPrec ()
    forall a b. (a -> b) -> a -> b
    $ Lexeme -> ReadP ()
    P.expect (Lexeme -> ReadP ()) -> Lexeme -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ String -> Lexeme
    P.Ident String
    name
            ReadPrec a -> ReadPrec a
    forall a. ReadPrec a -> ReadPrec a
    P.step ReadPrec a
    pars
    {-# INLINE expectPrefix #-}

    -- | Helper function for defining bijective Read instances that represent a
    -- common use case where a constructor (or constructor-like pattern) name
    -- (optionally) precedes an internal value with a separate parse function
    defRead :: Eq a => String -> (b -> a) -> P.ReadPrec b -> P.ReadPrec a
    defRead :: forall a b. Eq a => String -> (b -> a) -> ReadPrec b -> ReadPrec a
    defRead String
    name b -> a
    wrap ReadPrec b
    redPrec = String -> ReadPrec a -> ReadPrec a
    forall a. String -> ReadPrec a -> ReadPrec a
    expectPrefix String
    name (ReadPrec a -> ReadPrec a) -> ReadPrec a -> ReadPrec a
    forall a b. (a -> b) -> a -> b
    $ b -> a
    wrap (b -> a) -> ReadPrec b -> ReadPrec a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReadPrec b
    redPrec
    {-# INLINE defRead #-}

    -- | Alias for showsPrec that pairs well with `_readInt`
    _showInt :: Show a => Int -> a -> ShowS
    _showInt :: forall a. Show a => Int -> a -> ShowS
    _showInt = Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec
    {-# INLINE _showInt #-}

    -- | More descriptive alias for `safeInt`
    _readInt :: (Bounded a, Integral a) => P.ReadPrec a
    _readInt :: forall a. (Bounded a, Integral a) => ReadPrec a
    _readInt = ReadPrec a
    forall a. (Bounded a, Integral a) => ReadPrec a
    safeInt
    {-# INLINE _readInt #-}

    -- | show two elements of a tuple separated by a space character
    -- inverse function to readIntInt when used on integer-like values
    showIntInt :: (Show a, Show b) => Int -> (a, b) -> ShowS
    showIntInt :: forall a b. (Show a, Show b) => Int -> (a, b) -> ShowS
    showIntInt Int
    i (a
    x, b
    y) = Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    _showInt Int
    i a
    x ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    ' ' ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> b -> ShowS
    forall a. Show a => Int -> a -> ShowS
    _showInt Int
    i b
    y
    {-# INLINE showIntInt #-}

    -- | consume and return two integer-like values from two consecutive lexical tokens
    readIntInt
        :: (Bounded a, Integral a, Bounded b, Integral b) => P.ReadPrec (a, b)
    readIntInt :: forall a b.
    (Bounded a, Integral a, Bounded b, Integral b) =>
    ReadPrec (a, b)
    readIntInt = do
        x <- ReadPrec a
    forall a. (Bounded a, Integral a) => ReadPrec a
    _readInt
        y <- _readInt
        return (x, y)
    {-# INLINE readIntInt #-}

    bijectiveShow
        :: Eq a => Bijection a String -> (Int -> a -> ShowS) -> (Int -> a -> ShowS)
    bijectiveShow :: forall a.
    Eq a =>
    Bijection a String -> (Int -> a -> ShowS) -> Int -> a -> ShowS
    bijectiveShow Bijection a String
    bi Int -> a -> ShowS
    def = \Int
    i a
    x ->
        case Bijection a String -> Either a String -> Either a String
    forall a b. (Eq a, Eq b) => [Pair a b] -> Either a b -> Either a b
    lookBetween Bijection a String
    bi (a -> Either a String
    forall a b. a -> Either a b
    Left a
    x) of
            Right String
    y -> String -> ShowS
    showString String
    y
            Either a String
    _ -> Int -> a -> ShowS
    def Int
    i a
    x

    bijectiveRead :: Eq a => Bijection a String -> P.ReadPrec a -> P.ReadPrec a
    bijectiveRead :: forall a. Eq a => Bijection a String -> ReadPrec a -> ReadPrec a
    bijectiveRead Bijection a String
    bi ReadPrec a
    def = ReadPrec a -> ReadPrec a
    forall a. ReadPrec a -> ReadPrec a
    P.parens (ReadPrec a -> ReadPrec a) -> ReadPrec a -> ReadPrec a
    forall a b. (a -> b) -> a -> b
    $ ReadPrec a
    bijective ReadPrec a -> ReadPrec a -> ReadPrec a
    forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
    <++ ReadPrec a
    def
      where
        bijective :: ReadPrec a
    bijective = do
            (P.Ident y) <- ReadPrec Lexeme
    P.lexP
            case lookBetween bi (Right y) of
                Left a
    x -> a -> ReadPrec a
    forall a. a -> ReadPrec a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
                Either a String
    _ -> ReadPrec a
    forall a. ReadPrec a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    app_prec :: Int
    app_prec :: Int
    app_prec = Int
    10
    {-# INLINE app_prec #-}

    -- Parse integral values with type-specific overflow and underflow bounds-checks
    safeInt :: forall a. (Bounded a, Integral a) => P.ReadPrec a
    safeInt :: forall a. (Bounded a, Integral a) => ReadPrec a
    safeInt = do
        i <- ReadPrec Integer
    signed
        if (i >= fromIntegral (minBound :: a) && i <= fromIntegral (maxBound :: a))
            then return $ fromIntegral i
            else mzero
      where
        signed :: P.ReadPrec Integer
        signed :: ReadPrec Integer
    signed = ReadPrec Integer
    forall a. Read a => ReadPrec a
    P.readPrec