{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{- |
  Core compile-time utilities for embedding Elm programs in Haskell.

  This module runs the @elm@ compiler during Template Haskell
  splices and returns the compiled output as a 'String'. It is the
  low-level building block used by higher-level modules such as
  "System.Elm.Middleware".

  == Quick start

  1) Ensure @elm@ is available when GHC runs Template Haskell. If
  you use Cabal, add 'System.Elm.Middleware.requireElm' to your
  @Setup.hs@ (see "System.Elm.Middleware" for details).

  2) Call 'compileElm' from a Template Haskell splice:

  > import Language.Haskell.TH
  > import System.Elm.Compile
  >
  > embeddedJs :: Q String
  > embeddedJs = compileElm Dev JavaScript "frontend/Main.elm"

  3) Splice the result into your program:

  > myJs :: String
  > myJs = $(embeddedJs)

  == Choosing a 'Mode'

  'Mode' controls which flags are passed to @elm make@:

  * 'Dev' — no extra flags (the default for local development)
  * 'Debug' — passes @--debug@ (debug runtime, better errors)
  * 'Optimize' — passes @--optimize@ (smaller, faster output)

  Examples:

  > compileElm Dev JavaScript "frontend/Main.elm"
  >
  > compileElm Debug JavaScript "frontend/Main.elm"
  >
  > compileElm Optimize JavaScript "frontend/Main.elm"

  == Choosing an 'ElmOutputFormat'

  'ElmOutputFormat' selects whether @elm make@ produces a standalone
  JavaScript bundle or a complete HTML page:

  * 'JavaScript' — compile to @.js@ (typical for SPAs loaded by your
    own HTML template)
  * 'Html' — compile to a self-contained @.html@ page

  Examples:

  > -- JavaScript bundle for a custom HTML shell
  > compileElm Dev JavaScript "frontend/Main.elm"
  >
  > -- Full HTML page served as-is
  > compileElm Dev Html "frontend/Main.elm"

  == Embedding in other types

  'compileElm' returns a plain 'String'. Convert it however your
  application needs:

  > import qualified Data.Text as T
  >
  > embeddedText :: Q T.Text
  > embeddedText = T.pack <$> compileElm Dev JavaScript "frontend/Main.elm"

  > import qualified Data.ByteString.Char8 as BS8
  >
  > embeddedBytes :: Q BS8.ByteString
  > embeddedBytes = BS8.pack <$> compileElm Dev JavaScript "frontend/Main.elm"

  == Using with typed splices

  For a typed expression splice, bind the compiled content in @Q@ and
  lift it:

  > import Language.Haskell.TH
  >
  > myJs :: String
  > myJs = $(do
  >   js <- compileElm Optimize JavaScript "frontend/Main.elm"
  >   [| js |]
  >   )

  == Recompilation

  'compileElm' registers the @.elm@ source file as a Template Haskell
  dependency via 'addDependentFile'. GHC can re-run the splice when
  that file changes, but that only effectively works if the @.elm@
  file is also listed under @extra-source-files@ in your @.cabal@ file
  — otherwise Cabal may not rebuild the Haskell module when the Elm
  source changes.

  Example:

  > extra-source-files:
  >   frontend/Main.elm

  == Relationship to "System.Elm.Middleware"

  If you want to serve compiled Elm as WAI 'Middleware', use
  "System.Elm.Middleware" instead — it wraps 'compileElm' for that
  purpose. Use this module when you want the compiled output
  directly (for example, embedding JavaScript in a HTML template you
  write yourself, or serving it through your own HTTP layer).

-}
module System.Elm.Compile (
  Mode (..),
  ElmOutputFormat (..),
  compileElm,
)
where

import Control.Exception.Safe (tryAny)
import Control.Monad (Monad((>>=)), void)
import Data.String (IsString)
import Language.Haskell.TH (Q, runIO)
import Language.Haskell.TH.Syntax (addDependentFile)
import Prelude
  ( Bool(True), Functor(fmap), Maybe(Just, Nothing), MonadFail(fail)
  , Semigroup((<>)), Show(show), ($), (++), (.), Eq, FilePath, String, putStrLn
  )
import System.Directory (createDirectory, removeDirectoryRecursive)
import System.Exit (ExitCode(ExitSuccess))
import System.Posix
  ( ProcessStatus(Exited), executeFile, forkProcess, getProcessStatus
  )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

data Mode
  = Optimize
  | Dev
  | Debug
  deriving stock (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> FilePath
(Int -> Mode -> ShowS)
-> (Mode -> FilePath) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> FilePath
show :: Mode -> FilePath
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show)


data ElmOutputFormat
  = JavaScript
  | Html
  deriving stock (ElmOutputFormat -> ElmOutputFormat -> Bool
(ElmOutputFormat -> ElmOutputFormat -> Bool)
-> (ElmOutputFormat -> ElmOutputFormat -> Bool)
-> Eq ElmOutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElmOutputFormat -> ElmOutputFormat -> Bool
== :: ElmOutputFormat -> ElmOutputFormat -> Bool
$c/= :: ElmOutputFormat -> ElmOutputFormat -> Bool
/= :: ElmOutputFormat -> ElmOutputFormat -> Bool
Eq, Int -> ElmOutputFormat -> ShowS
[ElmOutputFormat] -> ShowS
ElmOutputFormat -> FilePath
(Int -> ElmOutputFormat -> ShowS)
-> (ElmOutputFormat -> FilePath)
-> ([ElmOutputFormat] -> ShowS)
-> Show ElmOutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElmOutputFormat -> ShowS
showsPrec :: Int -> ElmOutputFormat -> ShowS
$cshow :: ElmOutputFormat -> FilePath
show :: ElmOutputFormat -> FilePath
$cshowList :: [ElmOutputFormat] -> ShowS
showList :: [ElmOutputFormat] -> ShowS
Show)


buildDir :: (IsString a) => a
buildDir :: forall a. IsString a => a
buildDir = a
".om-elm-build-dir"


{- |
  Compile an Elm program at Template Haskell time.

  This function invokes @elm make@, reads the compiler output from a
  temporary build directory, and returns the contents as a 'String'.
  The caller is responsible for interpreting the result — for example,
  choosing an HTTP content type or converting to 'Text'.

  == Parameters

  * __mode__ — compiler flags ('Dev', 'Debug', or 'Optimize')
  * __format__ — output shape ('JavaScript' or 'Html')
  * __elmFile__ — path to the @.elm@ entrypoint, relative to the
    project root (same path you would pass to @elm make@ on the command
    line)

  == Basic examples

  Compile a JavaScript bundle with default (dev) settings:

  > compileElm Dev JavaScript "frontend/Main.elm"

  Compile an optimized JavaScript bundle:

  > compileElm Optimize JavaScript "frontend/Main.elm"

  Compile a self-contained HTML page:

  > compileElm Dev Html "frontend/Main.elm"

  == Splicing into top-level definitions

  > myJs :: String
  > myJs = $(compileElm Dev JavaScript "frontend/Main.elm")

  > myHtml :: String
  > myHtml = $(compileElm Dev Html "frontend/Main.elm")

  == Splicing into a larger Template Haskell computation

  > import Language.Haskell.TH
  >
  > myJs :: String
  > myJs = $(do
  >   js <- compileElm Optimize JavaScript "frontend/Main.elm"
  >   [| js |]
  >   )

  == Combining mode and format

  > -- Debug runtime, JavaScript output
  > compileElm Debug JavaScript "frontend/Main.elm"
  >
  > -- Optimized production build, HTML output
  > compileElm Optimize Html "frontend/Main.elm"
  >
  > -- Dev build, JavaScript output (most common for SPAs)
  > compileElm Dev JavaScript "frontend/Main.elm"

  == Requirements

  * The @elm@ executable must be on @PATH@ when GHC runs this splice.
  * The @elmFile@ path must exist at compile time.
  * GHC can re-run the splice when @elmFile@ changes (via
    'addDependentFile'), but that only effectively works if @elmFile@
    is also listed under @extra-source-files@ in your @.cabal@ file
    (see the module documentation for an example).

  See the module documentation for setup instructions and more
  embedding examples.

-}
compileElm
  :: Mode
  -> ElmOutputFormat
  -> FilePath
  -> Q String
compileElm :: Mode -> ElmOutputFormat -> FilePath -> Q FilePath
compileElm Mode
mode ElmOutputFormat
format FilePath
elmFile = do
  FilePath -> Q ()
addDependentFile FilePath
elmFile
  IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ do
    IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> (IO () -> IO (Either SomeException ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
forall a. IsString a => a
buildDir
    FilePath -> IO ()
createDirectory FilePath
forall a. IsString a => a
buildDir
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Compiling elm file: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
elmFile
    let
      flags :: [String]
      flags :: [FilePath]
flags =
        case Mode
mode of
          Mode
Debug -> [FilePath
"--debug"]
          Mode
Dev -> []
          Mode
Optimize -> [FilePath
"--optimize"]
    IO () -> IO ProcessID
forkProcess
      (
        FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
"elm" Bool
True ([
            FilePath
"make",
            FilePath
elmFile,
            FilePath
"--output=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ElmOutputFormat -> FilePath
buildFile ElmOutputFormat
format
          ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
flags) Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
      ) IO ProcessID
-> (ProcessID -> IO (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
True IO (Maybe ProcessStatus)
-> (Maybe ProcessStatus -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe ProcessStatus
Nothing -> FilePath -> IO FilePath
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"elm should have ended."
          Just (Exited ExitCode
ExitSuccess) ->
            (ByteString -> FilePath) -> IO ByteString -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
BS8.unpack (FilePath -> IO ByteString
BS.readFile (ElmOutputFormat -> FilePath
buildFile ElmOutputFormat
format))
          Maybe ProcessStatus
e -> FilePath -> IO FilePath
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"elm failed with: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ProcessStatus -> FilePath
forall a. Show a => a -> FilePath
show Maybe ProcessStatus
e


buildFile :: ElmOutputFormat -> FilePath
buildFile :: ElmOutputFormat -> FilePath
buildFile = \case
  ElmOutputFormat
JavaScript -> FilePath
forall a. IsString a => a
buildDir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/elm.js"
  ElmOutputFormat
Html -> FilePath
forall a. IsString a => a
buildDir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/elm.html"