From e7c09831bcfe0de1be2406ce64970fc29a4bb50c Mon Sep 17 00:00:00 2001
From: Rick Winfrey <rewinfrey@github.com>
Date: Tue, 11 Oct 2016 15:22:37 -0500
Subject: [PATCH] Add development mode

When developing locally, especially when using break to look at
structure, the timeout is too quick. Instead of manually updating the
timeout to a long duration, I figure disabling it when needed in the
context of ghci would be nicer.
---
 src/Arguments.hs    |  4 ++++
 src/SemanticDiff.hs | 14 +++++++++++---
 2 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/src/Arguments.hs b/src/Arguments.hs
index d8eabdcde..9ebe977d6 100644
--- a/src/Arguments.hs
+++ b/src/Arguments.hs
@@ -26,6 +26,7 @@ data CmdLineOptions = CmdLineOptions
   , outputFilePath :: Maybe FilePath
   , noIndex :: Bool
   , extraArgs :: [ExtraArg]
+  , developmentMode' :: Bool
   }
 
 -- | Arguments for the program (includes command line, environment, and defaults).
@@ -38,6 +39,7 @@ data Arguments = Arguments
   , diffMode :: DiffMode
   , shaRange :: Both (Maybe String)
   , filePaths :: [FilePath]
+  , developmentMode :: Bool
   } deriving (Show)
 
 -- | Returns Arguments for the program from parsed command line arguments.
@@ -62,6 +64,7 @@ programArguments CmdLineOptions{..} = do
       (_, _) -> CommitDiff
     , shaRange = fetchShas extraArgs
     , filePaths = filePaths
+    , developmentMode = developmentMode'
     }
   where
     fetchPaths :: [ExtraArg] -> [FilePath]
@@ -85,6 +88,7 @@ args gitDir sha1 sha2 filePaths format = Arguments
   , diffMode = CommitDiff
   , shaRange = Just <$> both sha1 sha2
   , filePaths = filePaths
+  , developmentMode = False
   }
 
 -- | 7 seconds
diff --git a/src/SemanticDiff.hs b/src/SemanticDiff.hs
index 3da4eb231..dc068b1ae 100644
--- a/src/SemanticDiff.hs
+++ b/src/SemanticDiff.hs
@@ -49,6 +49,7 @@ argumentsParser = info (version <*> helper <*> argumentsP)
       <*> optional (strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaults to stdout if unspecified"))
       <*> switch (long "no-index" <> help "compare two paths on the filesystem")
       <*> some (argument (eitherReader parseShasAndFiles) (metavar "SHA_A..SHAB FILES..."))
+      <*> switch (long "development" <> short 'd' <> help "set development mode which prevents timeout behavior by default")
       where
         parseShasAndFiles :: String -> Either String ExtraArg
         parseShasAndFiles s = case matchRegex regex s of
@@ -66,8 +67,12 @@ version = infoOption versionString (long "version" <> short 'V' <> help "output
 -- | Compare changes between two commits.
 diffCommits :: Arguments -> IO ()
 diffCommits args@Arguments{..} = do
-  ts <- Timeout.timeout timeoutInMicroseconds (fetchDiffs args)
+  ts <- fetchTerms args
   writeToOutput output (maybe mempty R.concatOutputs ts)
+  where fetchTerms args = if developmentMode
+                            then Just <$> fetchDiffs args
+                            else Timeout.timeout timeoutInMicroseconds (fetchDiffs args)
+
 
 -- | Compare two paths on the filesystem (compariable to git diff --no-index).
 diffPaths :: Arguments -> Both FilePath -> IO ()
@@ -99,14 +104,17 @@ fetchDiff' Arguments{..} filepath = do
 
   let sources = fromMaybe (Source.emptySourceBlob filepath) <$> sourcesAndOids
   let sourceBlobs = Source.idOrEmptySourceBlob <$> sources
-
   let textDiff = D.textDiff (parserForFilepath filepath) diffArguments sourceBlobs
-  text <- liftIO $ Timeout.timeout timeoutInMicroseconds textDiff
 
+  text <- fetchText textDiff
   truncatedPatch <- liftIO $ D.truncatedDiff diffArguments sourceBlobs
   pure $ fromMaybe truncatedPatch text
   where
     diffArguments = R.DiffArguments { format = format, output = output }
+    fetchText textDiff = if developmentMode
+                          then liftIO $ Timeout.timeout timeoutInMicroseconds textDiff
+                          else liftIO $ Just <$> textDiff
+
 
 pathsToDiff :: Arguments -> Both String -> IO [FilePath]
 pathsToDiff Arguments{..} shas = withRepository lgFactory gitDir $ do