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
type RawTemplate = ByteString
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
'\\')
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
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