{-# LANGUAGE DeriveGeneric #-}

module Hedgehog.Extras.Stock.IO.Network.Sprocket
  ( Sprocket(..)
  , doesSprocketExist
  , sprocketArgumentName
  , sprocketSystemName
  , maxSprocketArgumentNameLength
  ) where

import           Data.Bool (Bool)
import           Data.Char (Char)
import           Data.Eq (Eq((==)))
import           Data.Functor (Functor(fmap))
import           Data.Int (Int)
import           Data.Semigroup (Semigroup((<>)))
import           Data.String (String)
import           Hedgehog.Extras.Stock.OS (isWin32)
import           System.IO (FilePath, IO)
import           Text.Show (Show)
import           GHC.Generics (Generic)

import qualified Hedgehog.Extras.Stock.IO.Network.NamedPipe as IO
import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO

-- | Socket emulation.  On Posix it represents a socket.  On Windows it represents a named pipe.
data Sprocket = Sprocket
  { Sprocket -> FilePath
sprocketBase :: String
  , Sprocket -> FilePath
sprocketName :: String
  } deriving (forall x. Rep Sprocket x -> Sprocket
forall x. Sprocket -> Rep Sprocket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sprocket x -> Sprocket
$cfrom :: forall x. Sprocket -> Rep Sprocket x
Generic, Sprocket -> Sprocket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sprocket -> Sprocket -> Bool
$c/= :: Sprocket -> Sprocket -> Bool
== :: Sprocket -> Sprocket -> Bool
$c== :: Sprocket -> Sprocket -> Bool
Eq, Int -> Sprocket -> ShowS
[Sprocket] -> ShowS
Sprocket -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Sprocket] -> ShowS
$cshowList :: [Sprocket] -> ShowS
show :: Sprocket -> FilePath
$cshow :: Sprocket -> FilePath
showsPrec :: Int -> Sprocket -> ShowS
$cshowsPrec :: Int -> Sprocket -> ShowS
Show)

-- | Test if the sprocket exists
doesSprocketExist :: Sprocket -> IO Bool
doesSprocketExist :: Sprocket -> IO Bool
doesSprocketExist Sprocket
socket = if Bool
isWin32
  then FilePath -> IO Bool
IO.doesNamedPipeExist (Sprocket -> FilePath
sprocketSystemName Sprocket
socket)
  else FilePath -> IO Bool
IO.doesSocketExist (Sprocket -> FilePath
sprocketSystemName Sprocket
socket)

-- | Use this to query the OS about the sprocket
sprocketSystemName :: Sprocket -> FilePath
sprocketSystemName :: Sprocket -> FilePath
sprocketSystemName sprocket :: Sprocket
sprocket@(Sprocket FilePath
base FilePath
name) = if Bool
isWin32
  then Sprocket -> FilePath
sprocketNamedPipeName Sprocket
sprocket
  else FilePath
base forall a. Semigroup a => a -> a -> a
<> FilePath
"/" forall a. Semigroup a => a -> a -> a
<> FilePath
name

-- | Use this when needing to pass a sprocket into a command line argument.
sprocketArgumentName :: Sprocket -> FilePath
sprocketArgumentName :: Sprocket -> FilePath
sprocketArgumentName sprocket :: Sprocket
sprocket@(Sprocket FilePath
_ FilePath
name) = if Bool
isWin32
  then Sprocket -> FilePath
sprocketNamedPipeName Sprocket
sprocket
  else FilePath
name

maxSprocketArgumentNameLength :: Int
maxSprocketArgumentNameLength :: Int
maxSprocketArgumentNameLength = if Bool
isWin32
  then Int
256
  else Int
104

-- | The named pipe name of the sprocket on Win32 systems
sprocketNamedPipeName :: Sprocket -> FilePath
sprocketNamedPipeName :: Sprocket -> FilePath
sprocketNamedPipeName (Sprocket FilePath
_ FilePath
name) = FilePath
"\\\\.\\pipe" forall a. Semigroup a => a -> a -> a
<> ShowS
dedupBackslash (FilePath
"\\" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
slackToBack FilePath
name)
  where slackToBack :: Char -> Char
        slackToBack :: Char -> Char
slackToBack Char
c = if Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
'\\' else Char
c
        dedupBackslash :: String -> String
        dedupBackslash :: ShowS
dedupBackslash (Char
'\\':Char
'\\':FilePath
xs) = ShowS
dedupBackslash (Char
'\\'forall a. a -> [a] -> [a]
:FilePath
xs)
        dedupBackslash (Char
x:FilePath
xs) = Char
xforall a. a -> [a] -> [a]
:ShowS
dedupBackslash FilePath
xs
        dedupBackslash [] = []