{-# LANGUAGE OverloadedStrings #-}

module Jikka.CPlusPlus.Convert.EmbedOriginalCode where

import qualified Data.Text as T
import Data.Version (showVersion)
import Paths_Jikka (version)

run' :: T.Text -> T.Text
run' :: Text -> Text
run' Text
input =
  let headers :: [Text]
headers =
        [ Text
"// This C++ code is transpiled using Jikka transpiler v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
showVersion Version
version) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" https://github.com/kmyk/Jikka",
          Text
"// The original Python code:"
        ]
   in [Text] -> Text
T.unlines ([Text]
headers [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"//     " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> [Text]
T.lines Text
input))

run :: T.Text -> T.Text -> T.Text
run :: Text -> Text -> Text
run Text
input Text
output = Text -> Text
run' Text
input Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
output