Merge pull request #73 from lamdera/clickable-errors-locations

Clickable error locations

Author: supermario

builder/src/Build.hs

@@ -708,7 +708,7 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti
   let
     pkg = projectTypeToPkg projectType
   in
-  case Compile.compile pkg ifaces modul of
+  case Compile.compile (Just (FP.makeRelative root path)) pkg ifaces modul of
     Right (Compile.Artifacts canonical annotations objects) ->
       case makeDocs docsNeed canonical of
         Left err ->
@@ -926,7 +926,7 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod
       projectTypeToPkg projectType
 
     compileInput ifaces =
-      case Compile.compile pkg ifaces modul of
+      case Compile.compile Nothing pkg ifaces modul of
         Right (Compile.Artifacts canonical annotations objects) ->
           let
             h = Can._name canonical
@@ -1173,12 +1173,12 @@ checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
 
 
 compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult
-compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
+compileOutside (Env key root projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
   let
     pkg = projectTypeToPkg projectType
     name = Src.getName modul
   in
-  case Compile.compile pkg ifaces modul of
+  case Compile.compile (Just (FP.makeRelative root path)) pkg ifaces modul of
     Right (Compile.Artifacts canonical annotations objects) ->
       do  Reporting.report key Reporting.BDone
           return $ ROutsideOk name (I.fromModule pkg canonical annotations) objects
@@ -1271,4 +1271,4 @@ lamderaIsLiveHarnessModule modul =
 lamderaLiveHarnessEnv :: Env -> Env
 lamderaLiveHarnessEnv env =
   -- adds the Lamdera cache directory as an additional source directory
-  env { _srcDirs = AbsoluteSrcDir (Lamdera.lamderaCache $ _root env) : _srcDirs env }
+  env { _srcDirs = AbsoluteSrcDir (Lamdera.lamderaCache $ _root env) : _srcDirs env }

builder/src/Elm/Details.hs

@@ -689,7 +689,7 @@ compile pkg mvar status =
               return Nothing
 
             Just results ->
-              case Compile.compile pkg (Map.mapMaybe getInterface results) modul of
+              case Compile.compile Nothing pkg (Map.mapMaybe getInterface results) modul of
                 Left _ ->
                   return Nothing
 

compiler/src/Compile.hs

@@ -30,14 +30,11 @@ import qualified Type.Solve as Type
 
 import qualified Lamdera.Wire3.Core
 import qualified Lamdera.Wire3.Interfaces
-import qualified Lamdera.Wire3.Helpers as Lamdera.Wire
 import Lamdera
-import qualified CanSer.CanSer as ToSource
-import qualified Data.Text as T
-import qualified Data.Utf8
 import qualified Lamdera.UiSourceMap
 import qualified Lamdera.Nitpick.DebugLog
 import qualified Lamdera.Evergreen.ModifyAST
+import qualified System.FilePath as FP
 
 
 -- import StandaloneInstances
@@ -53,10 +50,10 @@ data Artifacts =
     }
 
 
-{- The original compile function for reference -}
-compile :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts
-compile pkg ifaces modul =
-  Lamdera.alternativeImplementationWhen Lamdera.isWireEnabled_ (compile_ pkg ifaces modul) $
+{- The original compile function for reference. `maybePath` parameter added by Lamdera. -}
+compile :: Maybe FilePath -> Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts
+compile maybePath pkg ifaces modul =
+  Lamdera.alternativeImplementationWhen Lamdera.isWireEnabled_ (compile_ maybePath pkg ifaces modul) $
   do  canonical   <- canonicalize pkg ifaces modul
       annotations <- typeCheck modul canonical
       ()          <- nitpick canonical
@@ -108,8 +105,8 @@ optimize modul annotations canonical =
 
 -- @LAMDERA
 
-compile_ :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts
-compile_ pkg ifaces modul = do
+compile_ :: Maybe FilePath -> Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Either E.Error Artifacts
+compile_ maybePath pkg ifaces modul = do
   -- @TEMPORARY debugging
   -- Inject stub definitions for wire functions, so the canonicalize phase can run
   -- Necessary for user-code which references yet-to-be generated functions
@@ -151,8 +148,13 @@ compile_ pkg ifaces modul = do
       canonical3 :: Can.Module
       canonical3 =
         if (Lamdera.unsafePerformIO Lamdera.isLiveMode)
-          then Lamdera.UiSourceMap.updateDecls (Can._name canonical2) (Can._decls canonical2)
-                 & (\newDecls -> canonical2 { Can._decls = newDecls })
+          then
+            case maybePath of
+              Just path ->
+                Lamdera.UiSourceMap.updateDecls path (Can._name canonical2) (Can._decls canonical2)
+                     & (\newDecls -> canonical2 { Can._decls = newDecls })
+              Nothing ->
+                canonical2
           else canonical2
 
   -- ()          <- debugPassText "starting optimize" moduleName (pure ())

elm.cabal

@@ -267,6 +267,7 @@ Executable lamdera
         Lamdera.Repl
         Lamdera.Reporting.Evergreen
         Lamdera.Reporting.Suggestions
+        Lamdera.String
         Lamdera.TypeHash
         Lamdera.Types
         Lamdera.Update

ext-common/Ext/Common.hs

@@ -420,12 +420,6 @@ cq_ bin args input = do
   pure $ (exit, stdOut, stdErr)
 
 
-execCombineStdOutErr :: String -> [String] -> String -> IO String
-execCombineStdOutErr bin args input = do
-  (exit, stdOut, stdErr) <- c_ bin args input
-  pure $ stdErr <> stdOut
-
-
 requireBinary :: String -> IO FilePath
 requireBinary name = do
   x <- Dir.findExecutable name

ext-common/Ext/Query/Canonical.hs

@@ -54,7 +54,7 @@ loadSingleArtifacts path = do
   source <- File.readUtf8 path
   case Parse.fromByteString Parse.Application source of
     Right modul ->
-      case Compile.compile Pkg.dummyName ifaces modul of
+      case Compile.compile Nothing Pkg.dummyName ifaces modul of
         Right artifacts ->
           pure artifacts
 

extra/Lamdera/CLI/Live.hs

@@ -9,6 +9,7 @@ module Lamdera.CLI.Live where
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Char8
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Encoding as TE
@@ -20,11 +21,12 @@ import Data.Maybe (fromMaybe)
 import GHC.Word (Word64)
 
 import qualified System.Directory as Dir
-import System.FilePath ((</>), takeExtension)
+import qualified System.FilePath as FP
+import System.FilePath ((</>))
 import Control.Applicative ((<|>))
 import Control.Arrow ((***))
 import Control.Concurrent.STM (atomically, newTVarIO, readTVar, readTVarIO, writeTVar, TVar)
-import Control.Exception (finally)
+import Control.Exception (finally, try, SomeException)
 import qualified Language.Haskell.TH as TH
 import Data.FileEmbed (bsToExp)
 import qualified Data.Aeson.Encoding as A
@@ -49,12 +51,13 @@ import System.Entropy (getEntropy)
 import Snap.Util.FileServe (
     getSafePath, serveDirectoryWith, defaultDirectoryConfig, defaultMimeTypes, mimeTypes, DirectoryConfig
   )
-import Control.Monad (guard)
+import Control.Monad (guard, mfilter)
 
 import qualified Lamdera.CLI.Check
 import qualified Lamdera.Relative
 import qualified Lamdera.Version
 import qualified Ext.Common
+import qualified GHC.IO.Exception
 
 
 
@@ -119,7 +122,7 @@ directoryConfig =
 serveUnmatchedUrlsToIndex :: FilePath -> (FilePath -> Snap()) -> Snap ()
 serveUnmatchedUrlsToIndex root serveElm =
   do  file <- getSafePath
-      guard (takeExtension file == "")
+      guard (FP.takeExtension file == "")
       serveElm (lamderaCache root </> "Lamdera" </> "Live.elm")
 
 
@@ -309,26 +312,24 @@ serveWebsocket root (mClients, mLeader, mChan, beState) =
 
 openEditorHandler :: FilePath -> Snap ()
 openEditorHandler root = do
-  fullpath <- T.pack <$> getSafePath
-  let
-    handlers =
-      -- *nix dir paths
-      [ ("_x/editor", serveEditorOpen root)
-      -- Windows dir paths
-      , ("_x\\editor", serveEditorOpen root)
-      ]
-  handlers
-    & List.find (\(prefix, handler) ->
-      prefix `T.isPrefixOf` fullpath
-    )
-    & fmap (\(prefix, handler) -> do
-      let path =
-            fullpath & T.replace (prefix <>  "/") ""  -- Strip when sub-dirs
-                     & T.replace (prefix <>  "\\") "" -- Strip when sub-dirs windows
-                     & T.replace prefix ""            -- Strip when root dir
-      handler path
-    )
-    & withDefault pass
+  fullpath <- getSafePath
+  debug $ "_x/editor fullpath: " ++ fullpath
+  case FP.splitDirectories fullpath of
+    "_x" : "editor" : rest -> do
+      maybeRow <- getQueryParam "row"
+      maybeColumn <- getQueryParam "column"
+
+      let parseNonNegative = mfilter (>= 0) . readMaybe . Data.ByteString.Char8.unpack
+
+      case (maybeRow >>= parseNonNegative, maybeColumn >>= parseNonNegative) of
+        (Just row, Just column) ->
+          serveEditorOpen root (FP.joinPath rest) row column
+
+        _ ->
+          error400PlainText "Unexpected request, expecting format: /_x/editor/<filename>?row=<row>&column=<column>"
+
+    _ ->
+      pass
 
 
 serveBem :: LiveState -> Snap ()
@@ -431,80 +432,83 @@ serveExperimentalList root path = do
       error404 "folder not found"
 
 
-serveEditorOpen :: FilePath -> Text -> Snap ()
-serveEditorOpen root path = do
+serveEditorOpen :: FilePath -> FilePath -> Int -> Int -> Snap ()
+serveEditorOpen root path row column = do
   debug $ "_x/editor received: " ++ show path
-  case path & T.splitOn ":" of
-    file:row:column:xs -> do
-      let fullpath = (root </> T.unpack file)
-      debug $ "_x/editor: " ++ show fullpath
-      exists_ <- liftIO $ Dir.doesFileExist fullpath
-      if exists_
-        then do
-          tryOpenInDetectedEditor root fullpath row column
-
-        else do
-          error404 "file not found"
-    _ ->
-      error404 "unexpected identifier, expecting format: <filename>:<row>:<column>"
+  let fullpath = root </> path
+  debug $ "_x/editor: " ++ show fullpath
+  exists_ <- liftIO $ Dir.doesFileExist fullpath
+  if exists_
+    then do
+      tryOpenInDetectedEditor root fullpath row column
+
+    else do
+      error400PlainText "File not found"
 
 
-tryOpenInDetectedEditor :: FilePath -> FilePath -> Text -> Text -> Snap ()
+tryOpenInDetectedEditor :: FilePath -> FilePath -> Int -> Int -> Snap ()
 tryOpenInDetectedEditor root file row column = do
-  res <- liftIO $ mapM id (editors root)
+  res <- liftIO $ sequence (editors root)
   case justs res of
     [] ->
-      -- @TODO give more helpful error that guides user how to configure things?
-      error404 "No supported editors found"
+      error404 "No supported editors found. See the Lamdera docs for more information."
 
-    (editor, openEditor):xs -> do
+    (editor, openEditor):_ -> do
       debug "📝  found the following editors, opening first:"
       justs res & fmap fst & show & debug
 
-      liftIO $ openEditor file row column
-      jsonResponse $ "{ status: 'tried opening editor " <> editor <> "' }"
+      runRes <- liftIO (try (openEditor file row column) :: IO (Either SomeException (GHC.IO.Exception.ExitCode, String, String)))
+      case runRes of
+        Right (exit, stdout, stderr) ->
+          case exit of
+            GHC.IO.Exception.ExitSuccess ->
+              noContentResponse
+
+            GHC.IO.Exception.ExitFailure exitCode ->
+              error400PlainText $ Ext.Common.stringToBuilder $ "exit " <> show exitCode <> ": " <> stdout <> stderr
+
+        Left err ->
+          error400PlainText $ Ext.Common.stringToBuilder $ show err
 
 
-type EditorOpenIO = (FilePath -> Text -> Text -> IO String)
+type EditorOpenIO = (FilePath -> Int -> Int -> IO (GHC.IO.Exception.ExitCode, String, String))
 
 
 editors :: FilePath -> [IO (Maybe (B.Builder, EditorOpenIO))]
 editors projectRoot =
   [ detectEditor "custom-*nix"
       (Dir.doesFileExist (projectRoot </> "openEditor.sh"))
-      (\file row column -> Ext.Common.execCombineStdOutErr (projectRoot </> "openEditor.sh") [file, T.unpack row, T.unpack column] "")
+      (\file row column -> Ext.Common.c_ (projectRoot </> "openEditor.sh") [file, show row, show column] "")
 
   , detectEditor "custom-windows"
       (do
         exists <- Dir.doesFileExist (projectRoot </> "openEditor.bat")
         pure $ exists && ostype == Windows
       )
-      (\file row column -> Ext.Common.execCombineStdOutErr (projectRoot </> "openEditor.bat") [file, T.unpack row, T.unpack column] "")
+      (\file row column -> Ext.Common.c_ (projectRoot </> "openEditor.bat") [file, show row, show column] "")
 
   , detectExecutable "code-insiders"
       (\executablePath file row column -> do
-        Ext.Common.execCombineStdOutErr executablePath [ "-g", file <> ":" <> T.unpack row <> ":" <> T.unpack column] ""
+        Ext.Common.c_ executablePath [ "-g", file <> ":" <> show row <> ":" <> show column] ""
       )
 
   , detectExecutable "code"
       (\executablePath file row column -> do
-        Ext.Common.execCombineStdOutErr executablePath [ "-g", file <> ":" <> T.unpack row <> ":" <> T.unpack column] ""
+        Ext.Common.c_ executablePath [ "-g", file <> ":" <> show row <> ":" <> show column] ""
       )
 
   , detectEditor "intellij-ce"
       (Dir.doesDirectoryExist "/Applications/IntelliJ IDEA CE.app")
       (\file row column -> do
-        let column_ :: Int = column & readMaybeText & withDefault 1
         -- IntelliJ seems to number it's columns from 1 index
-        Ext.Common.execCombineStdOutErr "open" ["-na", "IntelliJ IDEA CE.app", "--args", "--line", T.unpack row, "--column", show (column_ - 1), file] ""
+        Ext.Common.c_ "open" ["-na", "IntelliJ IDEA CE.app", "--args", "--line", show row, "--column", show (column - 1), file] ""
       )
 
   , detectEditor "intellij"
       (Dir.doesDirectoryExist "/Applications/IntelliJ IDEA.app")
       (\file row column -> do
-        let column_ :: Int = column & readMaybeText & withDefault 1
         -- IntelliJ seems to number it's columns from 1 index
-        Ext.Common.execCombineStdOutErr "open" ["-na", "IntelliJ IDEA.app", "--args", "--line", T.unpack row, "--column", show (column_ - 1), file] ""
+        Ext.Common.c_ "open" ["-na", "IntelliJ IDEA.app", "--args", "--line", show row, "--column", show (column - 1), file] ""
       )
   ]
 
@@ -747,6 +751,14 @@ logger =
     atomicPutStrLn $ T.unpack $ TE.decodeUtf8 bs
   )
 
+
+noContentResponse :: Snap ()
+noContentResponse = do
+  modifyResponse $ setResponseStatus 204 "No Content"
+  r <- getResponse
+  finishWith r
+
+
 jsonResponse :: B.Builder -> Snap ()
 jsonResponse s =
   do  modifyResponse $ setContentType "application/json; charset=utf-8"
@@ -784,11 +796,11 @@ error503 s =
       r <- getResponse
       finishWith r
 
-error400 :: B.Builder -> Snap ()
-error400 s =
+error400PlainText :: B.Builder -> Snap ()
+error400PlainText s =
   do  modifyResponse $ setResponseStatus 400 "Bad Request"
-      modifyResponse $ setContentType "application/json; charset=utf-8"
-      writeBuilder $ "{\"error\":\"" <> s <> "\"}"
+      modifyResponse $ setContentType "text/plain; charset=utf-8"
+      writeBuilder s
       r <- getResponse
       finishWith r
 

extra/Lamdera/String.hs

@@ -0,0 +1,23 @@
+module Lamdera.String (fromChars) where
+
+import qualified Data.Utf8 as Utf8
+import qualified Elm.String as ES
+
+
+fromChars :: [Char] -> ES.String
+fromChars =
+  Utf8.fromChars . escape
+
+
+escape :: [Char] -> [Char]
+escape =
+  foldr
+    (\c acc ->
+      case c of
+        '\\' -> '\\' : '\\' : acc
+        '\'' -> '\\' : '\'' : acc
+        '\n' -> '\\' : 'n'  : acc
+        '\r' -> '\\' : 'r'  : acc
+        _    -> c : acc
+    )
+    []