module Sos.Template
  ( RawTemplate
  , Template
  , parseTemplate
  , instantiateTemplate
  ) where

import Sos.Exception
import Sos.Job (ShellCommand)
import Sos.Utils

import Control.Applicative
import Control.Monad.Catch (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Text.ParserCombinators.ReadP

import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as LText


-- | A 'RawTemplate' represents a shell command, possibly containing capture
-- groups, e.g. "ghc \0"
type RawTemplate = ByteString

-- A 'Template' is a parsed 'RawTemplate' that replaces all capture groups with
-- Lefts.
--
-- For example, the raw template
--
--    "gcc -c \1.c -o \1.c"
--
-- will become
--
--    [Right "gcc -c ", Left 1, Right ".c -o ", Left 1, Right ".c"]
--
type Template = [Either Int ByteString]


parseTemplate :: MonadThrow m => RawTemplate -> m Template
parseTemplate :: forall (m :: * -> *). MonadThrow m => RawTemplate -> m Template
parseTemplate RawTemplate
raw_template =
  case forall a. ReadP a -> ReadS a
readP_to_S ReadP Template
parser (RawTemplate -> String
unpackBS RawTemplate
raw_template) of
    [(Template
template, String
"")] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Template
template
    [(Template, String)]
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RawTemplate -> SosException
SosCommandParseException RawTemplate
raw_template)
 where
  parser :: ReadP Template
  parser :: ReadP Template
parser = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ReadP Int
capturePart forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
<|||> ReadP RawTemplate
textPart) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
eof
   where
    capturePart :: ReadP Int
    capturePart :: ReadP Int
capturePart = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ReadP Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
digit)
     where
      digit :: Char -> Bool
      digit :: Char -> Bool
digit Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'

    textPart :: ReadP ByteString
    textPart :: ReadP RawTemplate
textPart = String -> RawTemplate
packBS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
munch1 (forall a. Eq a => a -> a -> Bool
/= Char
'\\')

-- Instantiate a template with a list of captured variables, per their indices.
--
-- For example,
--
--    instantiateTemplate ["ONE", "TWO"] [Right "foo", Left 0, Right "bar", Left 1] == "fooONEbarTWO"
--
instantiateTemplate
  :: forall m. MonadThrow m => [ByteString] -> Template -> m ShellCommand
instantiateTemplate :: forall (m :: * -> *).
MonadThrow m =>
[RawTemplate] -> Template -> m String
instantiateTemplate [RawTemplate]
vars0 Template
template0 = Int -> [RawTemplate] -> Template -> m String
go Int
0 [RawTemplate]
vars0 Template
template0
 where
  go :: Int -> [ByteString] -> Template -> m ShellCommand
  go :: Int -> [RawTemplate] -> Template -> m String
go Int
_ [] Template
template =
    case Template -> Either Int String
flattenTemplate Template
template of
      Left Int
n ->
        let err :: String
err = String
"uninstantiated template variable: \\" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
        in forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Template -> [RawTemplate] -> String -> SosException
SosCommandApplyException Template
template0 [RawTemplate]
vars0 String
err)
      Right String
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
  go Int
n (RawTemplate
t:[RawTemplate]
ts) Template
template = Int -> [RawTemplate] -> Template -> m String
go (Int
nforall a. Num a => a -> a -> a
+Int
1) [RawTemplate]
ts (forall a b. (a -> b) -> [a] -> [b]
map Either Int RawTemplate -> Either Int RawTemplate
f Template
template)
   where
    f :: Either Int ByteString -> Either Int ByteString
    f :: Either Int RawTemplate -> Either Int RawTemplate
f (Left Int
n')
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
n'   = forall a b. b -> Either a b
Right RawTemplate
t
        | Bool
otherwise = forall a b. a -> Either a b
Left Int
n'
    f Either Int RawTemplate
x = Either Int RawTemplate
x

-- Attempt to flatten a list of Rights to a single string.
flattenTemplate :: Template -> Either Int ShellCommand
flattenTemplate :: Template -> Either Int String
flattenTemplate = Builder -> Template -> Either Int String
go forall a. Monoid a => a
mempty
 where
  go :: LText.Builder -> Template -> Either Int ShellCommand
  go :: Builder -> Template -> Either Int String
go !Builder
acc [] = forall a b. b -> Either a b
Right (Text -> String
LText.unpack (Builder -> Text
LText.toLazyText Builder
acc))
  go !Builder
acc (Either Int RawTemplate
x:Template
xs) =
    case Either Int RawTemplate
x of
      Right RawTemplate
s ->
        let acc' :: Builder
acc' = Builder
acc forall a. Semigroup a => a -> a -> a
<> Text -> Builder
LText.fromText (RawTemplate -> Text
Text.decodeUtf8 RawTemplate
s)
        in Builder -> Template -> Either Int String
go Builder
acc' Template
xs
      Left Int
n -> forall a b. a -> Either a b
Left Int
n