{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

-- | Variadic process calling.
module Data.Conduit.Shell.Variadic
  ( ProcessType(..)
  , variadicProcess
  , CmdArg(..)
  ) where

import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import Data.Conduit.Shell.Process
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import Control.Applicative (pure)
import Control.Monad.IO.Class (MonadIO)

-- | A variadic process maker.
variadicProcess
  :: (ProcessType r)
  => String -> r
variadicProcess :: forall r. ProcessType r => String -> r
variadicProcess String
name = String -> [Text] -> r
forall t. ProcessType t => String -> [Text] -> t
spr String
name []

-- | Make the final conduit.
makeProcessLauncher :: MonadIO m => String -> [ST.Text] -> Segment m ()
makeProcessLauncher :: forall (m :: * -> *). MonadIO m => String -> [Text] -> Segment m ()
makeProcessLauncher String
name [Text]
args = String -> [String] -> Segment m ()
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Segment m ()
proc String
name ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
ST.unpack [Text]
args)

-- | Process return type.
class ProcessType t  where
  spr :: String -> [ST.Text] -> t

instance (r ~ (), MonadIO m) =>
         ProcessType (Segment m r) where
  spr :: String -> [Text] -> Segment m r
spr String
name [Text]
args = String -> [Text] -> Segment m ()
forall (m :: * -> *). MonadIO m => String -> [Text] -> Segment m ()
makeProcessLauncher String
name [Text]
args

-- | Accept strings as arguments.
instance (ProcessType r, CmdArg a) =>
         ProcessType (a -> r) where
  spr :: String -> [Text] -> a -> r
spr String
name [Text]
args = \a
a -> String -> [Text] -> r
forall t. ProcessType t => String -> [Text] -> t
spr String
name ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ a -> [Text]
forall a. CmdArg a => a -> [Text]
toTextArg a
a)

-- | Command line argument.
class CmdArg a  where
  toTextArg :: a -> [ST.Text]

instance CmdArg ST.Text where
  toTextArg :: Text -> [Text]
toTextArg = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. a -> a
id

instance CmdArg LT.Text where
  toTextArg :: Text -> [Text]
toTextArg = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict

instance CmdArg SB.ByteString where
  toTextArg :: ByteString -> [Text]
toTextArg = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
ST.decodeUtf8

instance CmdArg LB.ByteString where
  toTextArg :: ByteString -> [Text]
toTextArg = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8

instance CmdArg String where
  toTextArg :: String -> [Text]
toTextArg = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
ST.pack

instance CmdArg [String] where
  toTextArg :: [String] -> [Text]
toTextArg = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
ST.pack

instance CmdArg [ST.Text] where
  toTextArg :: [Text] -> [Text]
toTextArg = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. a -> a
id

instance CmdArg [LT.Text] where
  toTextArg :: [Text] -> [Text]
toTextArg = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
LT.toStrict

instance CmdArg [SB.ByteString] where
  toTextArg :: [ByteString] -> [Text]
toTextArg = (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
ST.decodeUtf8

instance CmdArg [LB.ByteString] where
  toTextArg :: [ByteString] -> [Text]
toTextArg = (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8)