Support git worktrees in lamdera check git-repo detection

extra/Lamdera.hs

@@ -134,6 +134,8 @@ module Lamdera
   , icdiff
   , withStdinYesAll
   , getGitBranch
+  , GitRepoStatus(..)
+  , gitRepoStatus
   , launchAppZero
   , killAppZero
   , head_
@@ -174,7 +176,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import Data.FileEmbed (bsToExp)
 import Language.Haskell.TH (runIO)
-import System.FilePath as FP ((</>), joinPath, splitDirectories, takeDirectory)
+import System.FilePath as FP ((</>), joinPath, splitDirectories, takeDirectory, isAbsolute)
 import qualified System.Directory as Dir
 import Control.Monad (unless, filterM)
 import System.Info
@@ -1117,6 +1119,64 @@ getGitBranch = do
   stdout & pack & strip & pure
 
 
+{-| Describes how the `.git` entry at a project root presents itself.
+
+In a normal clone `.git` is a directory. In a git worktree it is instead a text
+file containing a single `gitdir: <path>` line pointing at the real git
+directory under the main checkout's `.git/worktrees/<name>`. The `git` binary
+resolves this transparently, but our own existence checks need to be aware of
+it so we don't mistake a worktree for an uninitialised project. -}
+data GitRepoStatus
+  = GitRepoMissing                 -- ^ no `.git` at all -> safe to `git init`
+  | GitRepoDir                     -- ^ `.git` is a normal directory
+  | GitRepoWorktree FilePath       -- ^ `.git` is a file pointing at an existing gitdir
+  | GitRepoWorktreeBroken String   -- ^ `.git` is a file but malformed / dangling (reason)
+  deriving (Eq, Show)
+
+
+{-| Inspect the `.git` entry at a project root, following the worktree `gitdir:`
+pointer the same way `git` does. When `.git` is a file we verify it has the
+expected `gitdir: <path>` format and that the target directory exists, returning
+a specific reason for each failure case. -}
+gitRepoStatus :: FilePath -> IO GitRepoStatus
+gitRepoStatus root = do
+  let dotGit = root </> ".git"
+  isDir  <- Dir.doesDirectoryExist dotGit
+  isFile <- Dir.doesFileExist dotGit
+  if isDir
+    then pure GitRepoDir
+    else if not isFile
+      then pure GitRepoMissing
+      else do
+        contentsM <- readUtf8Text dotGit
+        case contentsM >>= parseGitdirPointer of
+          Nothing ->
+            pure $ GitRepoWorktreeBroken
+              ("Found a `.git` file at " <> dotGit <>
+               " but it does not contain the expected `gitdir: <path>` pointer.")
+          Just rel -> do
+            let target = if FP.isAbsolute rel then rel else root </> rel
+            targetExists <- Dir.doesDirectoryExist target
+            if targetExists
+              then pure (GitRepoWorktree target)
+              else pure $ GitRepoWorktreeBroken
+                ("The `.git` file at " <> dotGit <>
+                 " points to a git directory that does not exist: " <> target)
+
+
+{-| Parse the `gitdir: <path>` pointer from the first line of a worktree `.git`
+file, returning the path. -}
+parseGitdirPointer :: Text -> Maybe FilePath
+parseGitdirPointer contents =
+  case T.lines contents of
+    [] -> Nothing
+    (firstLine:_) ->
+      let trimmed = T.strip firstLine
+      in if T.isPrefixOf "gitdir:" trimmed
+           then Just $ T.unpack $ T.strip $ T.drop (T.length "gitdir:") trimmed
+           else Nothing
+
+
 launchAppZero :: Text -> IO ()
 launchAppZero appId = do
   callCommand $ "~/lamdera/scripts/launchAppZero.sh " <> unpack appId

extra/Lamdera/CLI/Check.hs

@@ -1023,27 +1023,38 @@ showExternalTypeWarnings warnings = do
 
 checkGitInitialised :: FilePath -> IO ()
 checkGitInitialised root = do
-  gitInitialised <- Dir.doesDirectoryExist $ root </> ".git"
-  onlyWhen (not gitInitialised) $ do
-    appName <- getInput $
-      D.vcat
-        [ "It looks like your project is missing a git repository!"
-        , "I can initialize it for you."
-        , "What is your Lamdera app name? [enter to skip]: "
-        ]
-
-    if appName == ""
-      then do
-        Progress.throw
-          $ Help.report "SKIPPING GIT INITIALISATION" (Nothing)
-            ("Okay, I'll let you set it up then!")
-            [ D.reflow "See <https://dashboard.lamdera.app/docs/building> for more."]
-      else do
-        progressPointer_ "Initialising git..."
-        callCommand $ "cd " <> root <> " && git init"
-        let gitAddRemoteCmd = "git remote add lamdera git@apps.lamdera.com:" <> appName <> ".git"
-        atomicPutStrLn $ "Adding remote: " <> gitAddRemoteCmd
-        callCommand $ "cd " <> root <> " && " <> gitAddRemoteCmd
+  status <- gitRepoStatus root
+  case status of
+    GitRepoDir -> pure ()
+    GitRepoWorktree _ -> pure ()
+    GitRepoWorktreeBroken reason ->
+      -- Don't offer `git init` here – that would clobber a worktree's `.git` file.
+      Progress.throw
+        $ Help.report "BROKEN GIT WORKTREE" (Nothing)
+          (reason)
+          [ D.reflow "This looks like a git worktree whose `.git` file is malformed or points to a git directory that no longer exists."
+          , D.reflow "Try re-creating the worktree, or run `git worktree repair` from the main checkout."
+          ]
+    GitRepoMissing -> do
+      appName <- getInput $
+        D.vcat
+          [ "It looks like your project is missing a git repository!"
+          , "I can initialize it for you."
+          , "What is your Lamdera app name? [enter to skip]: "
+          ]
+
+      if appName == ""
+        then do
+          Progress.throw
+            $ Help.report "SKIPPING GIT INITIALISATION" (Nothing)
+              ("Okay, I'll let you set it up then!")
+              [ D.reflow "See <https://dashboard.lamdera.app/docs/building> for more."]
+        else do
+          progressPointer_ "Initialising git..."
+          callCommand $ "cd " <> root <> " && git init"
+          let gitAddRemoteCmd = "git remote add lamdera git@apps.lamdera.com:" <> appName <> ".git"
+          atomicPutStrLn $ "Adding remote: " <> gitAddRemoteCmd
+          callCommand $ "cd " <> root <> " && " <> gitAddRemoteCmd
 
 
 genericExit :: String -> IO a

extra/Lamdera/Init.hs

@@ -4,7 +4,6 @@
 module Lamdera.Init where
 
 import System.FilePath ((</>))
-import qualified System.Directory as Dir
 import NeatInterpolation
 
 import Lamdera
@@ -22,7 +21,8 @@ writeDefaultImplementations = do
           else writeUtf8 (root </> filename) implementation
       )
   writeLineIfMissing "elm-stuff" (root </> ".gitignore")
-  onlyWhen_ (fmap not $ Dir.doesDirectoryExist (root </> ".git")) $ do
+  status <- gitRepoStatus root
+  onlyWhen (status == GitRepoMissing) $ do
     Ext.Common.cq_ "git" ["init"] ""
     pure ()
 

test/Test/Check.hs

@@ -6,6 +6,7 @@ module Test.Check where
 
 import System.FilePath ((</>))
 import qualified System.Directory as Dir
+import System.IO.Temp (withSystemTempDirectory)
 import qualified Data.Text as T
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -193,6 +194,54 @@ suite = tests $
         ,"bar : something"
         ,"bar =\n  and bar too, including it's type sig\n"]
         (Lamdera.CLI.Check.extractTopLevelExpressions input)
+
+  , scope "gitRepoStatus detects directories, worktrees, and broken pointers" $ do
+
+      -- No `.git` at all -> safe to offer `git init`
+      missing <- io $ withSystemTempDirectory "lamdera-git-missing" $ \tmp ->
+        gitRepoStatus tmp
+      scope "no .git -> GitRepoMissing" $ expectEqual GitRepoMissing missing
+
+      -- Normal clone: `.git` is a directory
+      normal <- io $ withSystemTempDirectory "lamdera-git-dir" $ \tmp -> do
+        Ext.Common.bash $ "cd " <> tmp <> " && git init -q"
+        gitRepoStatus tmp
+      scope ".git directory -> GitRepoDir" $ expectEqual GitRepoDir normal
+
+      -- Worktree: `.git` is a file pointing at an existing gitdir
+      worktree <- io $ withSystemTempDirectory "lamdera-git-wt" $ \tmp -> do
+        let mainDir = tmp </> "main"
+            wtDir = tmp </> "wt"
+        Dir.createDirectoryIfMissing True mainDir
+        Ext.Common.bash $ "cd " <> mainDir
+          <> " && git init -q"
+          <> " && git config user.email test@example.com"
+          <> " && git config user.name test"
+          <> " && git commit -q --allow-empty -m init"
+          <> " && git worktree add -q " <> wtDir
+        gitRepoStatus wtDir
+      scope "worktree .git file -> GitRepoWorktree" $
+        case worktree of
+          GitRepoWorktree _ -> ok
+          other -> crash $ "expected GitRepoWorktree, got " <> show other
+
+      -- `.git` is a file but doesn't contain a `gitdir:` pointer
+      malformed <- io $ withSystemTempDirectory "lamdera-git-malformed" $ \tmp -> do
+        writeUtf8 (tmp </> ".git") "not a gitdir line\n"
+        gitRepoStatus tmp
+      scope "malformed .git file -> GitRepoWorktreeBroken" $
+        case malformed of
+          GitRepoWorktreeBroken _ -> ok
+          other -> crash $ "expected GitRepoWorktreeBroken (malformed), got " <> show other
+
+      -- `.git` file points at a gitdir that doesn't exist
+      dangling <- io $ withSystemTempDirectory "lamdera-git-dangling" $ \tmp -> do
+        writeUtf8 (tmp </> ".git") "gitdir: /no/such/git/dir\n"
+        gitRepoStatus tmp
+      scope "dangling gitdir pointer -> GitRepoWorktreeBroken" $
+        case dangling of
+          GitRepoWorktreeBroken _ -> ok
+          other -> crash $ "expected GitRepoWorktreeBroken (dangling), got " <> show other
   ]