chore: only build files tracked by git (#315)

support/shake/app/Shake/Git.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE BlockArguments, GeneralizedNewtypeDeriving, TypeFamilies #-}
 
 module Shake.Git
-  ( gitCommit
+  ( gitFiles
+  , gitCommit
   , gitAuthors
   , gitRules
   ) where
@@ -22,6 +23,15 @@ import Development.Shake
 gitCommand :: CmdResult r => [String] -> Action r
 gitCommand args = command [] "git" (["--git-dir", ".git"] ++ args)
 
+newtype GitFiles = GitFiles ()
+  deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+type instance RuleResult GitFiles = [FilePath]
+
+-- | Get the list of files tracked by git.
+gitFiles :: Action [FilePath]
+gitFiles = askOracle (GitFiles ())
+
 newtype GitCommit = GitCommit ()
   deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
 
@@ -62,6 +72,10 @@ doGitAuthors (GitAuthors path) = do
 -- | Shake rules required for reading Git information.
 gitRules :: Rules()
 gitRules = versioned 1 do
+  _ <- addOracle \(GitFiles ()) -> do
+    Stdout t <- gitCommand ["ls-files", "--full-name"]
+    pure (lines t)
+
   _ <- addOracle \(GitCommit ()) -> do
     Stdout t <- gitCommand ["rev-parse", "--verify", "HEAD"]
     pure (head (lines t))

support/shake/app/Shake/Modules.hs

@@ -20,6 +20,9 @@ import GHC.Generics (Generic)
 
 import HTML.Backend (moduleName)
 
+import Shake.Git
+import Shake.Options
+
 type ModName = String
 
 data ModulesQ = ModulesQ
@@ -54,12 +57,19 @@ type instance RuleResult ModulesQ = ModulesA
 moduleRules :: Rules ()
 moduleRules = do
   _ <- addOracle \ModulesQ -> do
+    gitOnly <- getGitOnly
+
     let
+      isAgda x = any (?== x) ["src//*.agda", "src//*.lagda.md"]
+      getFiles = if gitOnly
+        then map dropDirectory1 . filter isAgda <$> gitFiles
+        else getDirectoryFiles "src" ["**/*.agda", "**/*.lagda.md"]
+
       toOut x | takeExtensions x == ".lagda.md"
               = (moduleName (dropExtensions x), WithText)
       toOut x = (moduleName (dropExtensions x), CodeOnly)
 
-    ModulesA . Map.fromList . map toOut <$> getDirectoryFiles "src" ["**/*.agda", "**/*.lagda.md"]
+    ModulesA . Map.fromList . map toOut <$> getFiles
   pure ()
 
 -- | Get all 1Lab modules.

support/shake/app/Shake/Options.hs

@@ -11,6 +11,7 @@ module Shake.Options
   , getSkipAgda
   , getWatching
   , getBaseUrl
+  , getGitOnly
   ) where
 
 import Development.Shake.Classes
@@ -31,6 +32,8 @@ data Options = Options
     -- ^ Launch in watch mode. Prevents some build tasks running.
   , _optBaseUrl   :: String
     -- ^ Base URL for absolute paths
+  , _optGitOnly   :: Bool
+    -- ^ Whether to only build files tracked by git.
   }
   deriving (Eq, Show, Typeable, Generic)
 
@@ -44,6 +47,7 @@ defaultOptions = Options
   , _optSkipAgda  = False
   , _optWatching  = Nothing
   , _optBaseUrl   = ""
+  , _optGitOnly   = False
   }
 
 data GetOptions = GetOptions deriving (Eq, Show, Typeable, Generic)
@@ -60,9 +64,10 @@ setOptions options = do
   _ <- addOracle $ \GetOptions -> pure options
   pure ()
 
-getSkipTypes, getSkipAgda, getWatching :: Action Bool
+getSkipTypes, getSkipAgda, getWatching, getGitOnly :: Action Bool
 getSkipTypes = _optSkipTypes <$> askOracle GetOptions
 getSkipAgda  = _optSkipAgda  <$> askOracle GetOptions
+getGitOnly   = _optGitOnly   <$> askOracle GetOptions
 getWatching  = isJust . _optWatching <$> askOracle GetOptions
 
 getBaseUrl :: Action String
@@ -78,5 +83,7 @@ _1LabOptDescrs =
   , Option [] ["skip-agda"] (NoArg (\r -> r { _optSkipAgda = True, _optSkipTypes = True }))
       "Skip typechecking Agda. Markdown files are read from src/ directly."
   , Option "b" ["base-url"] (ReqArg (\s r -> r { _optBaseUrl = s }) "URL")
-    "The base URL to use for absolute links. Should include the protocol."
+      "The base URL to use for absolute links. Should include the protocol."
+  , Option [] ["git-only"] (NoArg (\r -> r { _optGitOnly = True }))
+      "Only build files tracked by git."
   ]