{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module Endpoint.Compile
  ( endpoint
  , loadErrorJS
  )
  where


import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Data.Map.Utils as Map
import qualified Data.Name as N
import qualified Data.NonEmptyList as NE
import Snap.Core
import Snap.Util.FileUploads
import qualified System.Directory as Dir
import qualified System.IO.Streams as Stream
import Text.RawString.QQ (r)

import qualified Artifacts as A
import qualified Cors

import qualified AST.Source as Src
import qualified AST.Canonical as Can
import qualified AST.Optimized as Opt
import qualified BackgroundWriter as BW
import qualified Build
import qualified Compile
import qualified Elm.Details as Details
import qualified Elm.Interface as I
import qualified Elm.ModuleName as ModuleName
import qualified Elm.Package as Pkg
import qualified File
import qualified Generate
import qualified Generate.Html as Html
import qualified Generate.JavaScript as JS
import qualified Generate.Mode as Mode
import qualified Json.Encode as Encode
import qualified Parse.Module as Parse
import qualified Reporting
import qualified Reporting.Annotation as A
import Reporting.Doc ((<>))
import qualified Reporting.Doc as D
import qualified Reporting.Error as Error
import qualified Reporting.Error.Import as Import
import qualified Reporting.Exit as Exit
import qualified Reporting.Exit.Help as Help
import qualified Reporting.Task as Task



-- ALLOWED ORIGINS


allowedOrigins :: [String]
allowedOrigins =
  [ "https://elm-lang.org"
  , "https://package.elm-lang.org"
  ]



-- ENDPOINT


endpoint :: A.Artifacts -> Snap ()
endpoint artifacts =
  Cors.allow POST allowedOrigins $
  do  result <- foldMultipart defaultUploadPolicy ignoreFile 0
      case result of
        ([("code",source)], 0) ->
          do  modifyResponse $ setContentType "text/html; charset=utf-8"
              case compile artifacts source of
                Success builder ->
                  writeBuilder builder

                NoMain ->
                  writeBuilder $ renderReport noMain

                BadInput name err ->
                  writeBuilder $ renderReport $
                    Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []

        _ ->
          do  modifyResponse $ setResponseStatus 400 "Bad Request"
              modifyResponse $ setContentType "text/html; charset=utf-8"
              writeBS
                "<p>Unexpected request format. This should not be possible!</p>\
                \<p>Please report this\
                \ <a href=\"https://github.com/elm/compiler/issues\">here</a>\
                \ along with the URL and your browser version.</p>"


ignoreFile :: PartInfo -> Stream.InputStream B.ByteString -> Int -> IO Int
ignoreFile _ _ count =
  return (count + 1)



-- COMPILE


data Outcome
  = Success B.Builder
  | NoMain
  | BadInput ModuleName.Raw Error.Error


compile :: A.Artifacts -> B.ByteString -> Outcome
compile (A.Artifacts interfaces objects) source =
  case Parse.fromByteString Parse.Application source of
    Left err ->
      BadInput N._Main (Error.BadSyntax err)

    Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
      case checkImports interfaces imports of
        Left err ->
          BadInput (Src.getName modul) (Error.BadImports err)

        Right ifaces ->
          case Compile.compile Pkg.dummyName ifaces modul of
            Left err ->
              BadInput (Src.getName modul) err

            Right (Compile.Artifacts canModule _ locals) ->
              case locals of
                Opt.LocalGraph Nothing _ _ ->
                  NoMain

                Opt.LocalGraph (Just main_) _ _ ->
                  let
                    mode  = Mode.Dev Nothing
                    home  = Can._name canModule
                    name  = ModuleName._module home
                    mains = Map.singleton home main_
                    graph = Opt.addLocalGraph locals objects
                  in
                  Success $ Html.sandwich name $ JS.generate mode graph mains


checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
checkImports interfaces imports =
  let
    importDict = Map.fromValues Src.getImportName imports
    missing = Map.difference importDict interfaces
  in
  case Map.elems missing of
    [] ->
      Right (Map.intersection interfaces importDict)

    i:is ->
      let
        unimported =
          Map.keysSet (Map.difference interfaces importDict)

        toError (Src.Import (A.At region name) _ _) =
          Import.Error region name unimported Import.NotFound
      in
      Left (fmap toError (NE.List i is))



-- RENDER REPORT


renderReport :: Help.Report -> B.Builder
renderReport report =
  [r|<!DOCTYPE HTML>
<html>
<head>
  <meta charset="UTF-8">
  <style>body { padding: 0; margin: 0; background-color: black; }</style>
  <script src="https://worker.elm-lang.org/compile/errors.js"></script>
</head>
<body>
  <script>
    var app = Elm.Errors.init({flags:|] <> Encode.encodeUgly (Exit.toJson report) <> [r|});
    app.ports.jumpTo.subscribe(function(region) {
      window.parent.postMessage(JSON.stringify(region), '*');
    });
  </script>
</body>
</html>|]



-- NO MAIN


noMain :: Help.Report
noMain =
  Help.report "NO MAIN" Nothing
    (
      "Without a `main` value, I do not know what to show on screen!"
    )
    [ D.reflow $
        "Adding a `main` value can be as brief as:"
    , D.vcat
        [ D.fillSep [D.cyan "import","Html"]
        , ""
        , D.fillSep [D.green "main","="]
        , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
        ]
    , D.reflow $
        "Try adding something like that!"
    , D.toSimpleNote $
        "I recommend looking through https://guide.elm-lang.org for more advice on\
        \ how to fill in `main` values."
    ]



-- LOAD ERROR JS


loadErrorJS :: IO B.ByteString
loadErrorJS =
  let
    run work =
      do  result <- work
          case result of
            Right a -> return a
            Left _ -> error "problem building src/Errors.elm"
  in
  BW.withScope $ \scope ->
    do  root <- Dir.getCurrentDirectory
        details <- run $ Details.load Reporting.silent scope root
        artifacts <- run $ Build.fromPaths Reporting.silent root details (NE.List "src/Errors.elm" [])
        javascript <- run $ Task.run $ Generate.prod root details artifacts
        return $ LBS.toStrict $ B.toLazyByteString javascript