{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Language.Docker.EDSL.Quasi where

import qualified Data.Text as Text
import Language.Docker.EDSL
import qualified Language.Docker.Parser as Parser
import Language.Docker.Syntax.Lift ()
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Text.Megaparsec (errorBundlePretty)

-- | Quasiquoter for embedding dockerfiles on the EDSL
--
-- @
-- putStr $ 'toDockerfile' $ do
--     from "node"
--     run "apt-get update"
--     [edockerfile|
--     RUN apt-get update
--     CMD node something.js
--     |]
-- @
edockerfile :: QuasiQuoter
edockerfile :: QuasiQuoter
edockerfile = QuasiQuoter
dockerfile {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
edockerfileE}

edockerfileE :: String -> ExpQ
edockerfileE :: String -> Q Exp
edockerfileE String
e =
  case Text -> Either Error Dockerfile
Parser.parseText (String -> Text
Text.pack String
e) of
    Left Error
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Error -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty Error
err)
    Right Dockerfile
d -> [|embed d|]

dockerfile :: QuasiQuoter
dockerfile :: QuasiQuoter
dockerfile =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
dockerfileE,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Can't use Dockerfile as a declaration",
      quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Can't use Dockerfile as a pattern",
      quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Can't use Dockerfile as a type"
    }

dockerfileE :: String -> ExpQ
dockerfileE :: String -> Q Exp
dockerfileE String
e =
  case Text -> Either Error Dockerfile
Parser.parseText (String -> Text
Text.pack String
e) of
    Left Error
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Error -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty Error
err)
    Right Dockerfile
d -> Dockerfile -> Q Exp
forall t. Lift t => t -> Q Exp
lift Dockerfile
d