30a1f15 · obelisk · git.iko.soy

git.iko.soy/obelisk

Cleanup code

commit30a1f153f5590d1ab63038a6554398a87df67c5f authorSridhar Ratnakumar <srid@srid.ca> dateFri 22 Jun 2018, 15:50 (8 years ago) parent44ed123

8 files changed+33−36

compare with master

unifiedsplit

lib/cliapp/src/Obelisk/CliApp/Demo.hs+1−2 lib/cliapp/src/Obelisk/CliApp/Spinner.hs+7−7 lib/command/src/Obelisk/Command.hs+4−4 lib/command/src/Obelisk/Command/Upgrade.hs+9−11 lib/command/src/Obelisk/Command/Upgrade/Hash.hs+8−8 lib/migration/src/Obelisk/Migration.hs+4−4 migration/3b614d291e262d0f281b54ff42a6bb66-2e9a04a228106f62128ea5bd19d6b25e/obelisk-handoff migration/3b614d291e262d0f281b54ff42a6bb66-2e9a04a228106f62128ea5bd19d6b25e/obelisk-upgrade

lib/cliapp/src/Obelisk/CliApp/Demo.hs+1−2

@@ -4,8 +4,7 @@

44module Obelisk.CliApp.Demo where

66import Control.Concurrent (threadDelay)

7−import Control.Monad.IO.Class (liftIO)

8−import Control.Monad.Reader (MonadIO)

7+import Control.Monad.IO.Class

98import Data.Semigroup ((<>))

109import qualified Data.Text as T

1110import System.Process (proc)

lib/cliapp/src/Obelisk/CliApp/Spinner.hs+7−7

@@ -16,7 +16,6 @@ import Control.Monad (forM_, (>=>))

1616import Control.Monad.Catch (MonadMask, mask, onException)

1717import Control.Monad.IO.Class

1818import Control.Monad.Log (Severity (..), logMessage)

19−import Control.Monad.Reader (MonadIO)

2019import Data.IORef

2120import qualified Data.List as L

2221import Data.Maybe (isNothing)

@@ -35,10 +34,10 @@ withSpinner s = withSpinner' s $ Just $ const s

3534

3635-- | A spinner that leaves no trail after a successful run.

3736--

38−-- Use if you wish the spinner to be 'temporary' visually to the user.

37+-- Use if you wish the spinner to be ephemerally visible to the user.

3938--

40−-- The 'no trail' property automatically carries over to sub-spinners (in that they won't

41−-- leave a trail either).

39+-- The 'no trail' property automatically carries over to sub-spinners (in that

40+-- they won't leave a trail either).

4241withSpinnerNoTrail

4342 :: (MonadIO m, MonadMask m, Cli m, HasCliConfig m)

4443 => Text -> m a -> m a

@@ -80,7 +79,8 @@ withSpinner' msg mkTrail action = do

8079 ( TerminalString_Colorized Green "✔"

8180 , mkTrail <*> pure result

8281 )

83− forM_ logsM $ logMessage . Output_Write -- Last message, finish off with newline.

82+ -- Last message, finish off with newline.

83+ forM_ logsM $ logMessage . Output_Write

8484 pushSpinner (flag, old) =

8585 ( (isTemporary : flag, TerminalString_Normal msg : old)

8686 , null old -- Is empty?

@@ -133,8 +133,8 @@ runSpinner spinner f = forM_ spinner $ f >=> const delay

133133type SpinnerTheme = [Text]

134134

135135-- Find more spinners at https://github.com/sindresorhus/cli-spinners/blob/master/spinners.json

136−spinnerCircleHalves :: SpinnerTheme

137−spinnerCircleHalves = ["◐", "◓", "◑", "◒"]

136+_spinnerCircleHalves :: SpinnerTheme

137+_spinnerCircleHalves = ["◐", "◓", "◑", "◒"]

138138

139139spinnerMoon :: SpinnerTheme

140140spinnerMoon = ["🌑", "🌒", "🌓", "🌔", "🌕", "🌖", "🌗", "🌘"]

lib/command/src/Obelisk/Command.hs+4−4

@@ -252,7 +252,7 @@ parserPrefs = defaultPrefs

252252parseCLIArgs :: ArgsConfig -> [String] -> IO Args

253253parseCLIArgs cfg as = pure as >>= handleParseResult . execParserPure parserPrefs (argsInfo cfg)

254254

255−-- | Create an Obelisk config for this process.

255+-- | Create an Obelisk config for the current process.

256256mkObeliskConfig :: IO Obelisk

257257mkObeliskConfig = do

258258 cliArgs <- getArgs

@@ -269,7 +269,7 @@ mkObeliskConfig = do

269269 inShellCompletion <- liftIO $ isInfixOf "completion" . unwords <$> getArgs

270270 return $ isTerm && not inShellCompletion

271271

272−-- For use from development obelisk repls

272+-- | For use from development obelisk repls

273273--

274274-- Example:

275275-- > runCommand $ someFuncInMonadObelisk ...

@@ -306,8 +306,8 @@ mainWithHandOff argsCfg = \case

306306 HandOff_Decide f impl as -> do

307307 withSpinner' "Deciding whether to handoff"

308308 (Just $ bool

309− "Decided /not/ to handoff to project obelisk"

310− "Decided to handoff to project obelisk") f >>= \case

309+ "Continuing in ambient obelisk without handing off"

310+ "Handed off to project obelisk") f >>= \case

311311 True -> mainWithHandOff argsCfg $ HandOff_Yes impl as

312312 False -> mainWithHandOff argsCfg $ HandOff_No as

313313 HandOff_No as -> do

lib/command/src/Obelisk/Command/Upgrade.hs+9−11

@@ -87,8 +87,6 @@ decideHandOffToProjectOb project = do

8787 -- We don't have ambient's ob source code, so locate its hash from the

8888 -- graph. The last vertex should be it.

8989 ambientHash <- getLast (_migration_graph m)

90− unless (hasVertex ambientHash m) $

91− failWith "Ambient ob's hash is not in its own graph"

9290 return (m, ambientHash)

9391

9492-- | Return the path to the current ('ambient') obelisk process Nix directory

@@ -108,11 +106,11 @@ getObeliskBranch project = readThunk (toImplDir project) >>= \case

108106 Right (ThunkData_Packed tptr) -> case getThunkGitBranch tptr of

109107 Just v -> pure v

110108 Nothing ->

111− failWith "You must specify a git branch to `ob upgrade` as obelisk thunk does not specify any."

109+ failWith "You must run `ob upgrade` with the Git branch specified explicitly, as the project's obelisk thunk does not specify any."

112110

113111updateObelisk :: MonadObelisk m => FilePath -> Text -> m Hash

114112updateObelisk project gitBranch =

115− withSpinner ("Fetching new Obelisk [" <> gitBranch <> "]") $

113+ withSpinner ("Fetching new obelisk [" <> gitBranch <> "]") $

116114 updateThunk (toImplDir project) $ \obImpl -> do

117115 fromHash <- computeVertexHash obImpl

118116 callProcessAndLogOutput (Debug, Debug) $

@@ -123,15 +121,15 @@ updateObelisk project gitBranch =

123121

124122handOffToNewOb :: MonadObelisk m => FilePath -> Hash -> m ()

125123handOffToNewOb project fromHash = do

126− impl <- withSpinner' "Preparing for handoff" (Just $ ("Handed off to new Obelisk " <>) . T.pack) $

124+ impl <- withSpinner' "Preparing for handoff" (Just $ ("Handed off to new obelisk " <>) . T.pack) $

127125 findProjectObeliskCommand project >>= \case

128− Nothing -> failWith "Not an Obelisk project"

126+ Nothing -> failWith "Not an obelisk project"

129127 Just impl -> pure impl

130128 let opts = ["internal", "migrate", T.unpack fromHash]

131129 liftIO $ executeFile impl False ("--no-handoff" : opts) Nothing

132130

133131migrateObelisk :: MonadObelisk m => FilePath -> Hash -> m ()

134−migrateObelisk project fromHash = void $ withSpinner' "Migrating to new Obelisk" (Just id) $ do

132+migrateObelisk project fromHash = void $ withSpinner' "Migrating to new obelisk" (Just id) $ do

135133 updateThunk (toImplDir project) $ \obImpl -> revertObImplOnFail obImpl $ do

136134 toHash <- computeVertexHash obImpl

137135 g <- getMigrationGraph' obImpl MigrationGraph_ObeliskUpgrade >>= \case

@@ -192,18 +190,18 @@ verifyGraph obDir = do

192190 withSpinner "Checking graph integrity" $

193191 ensureGraphIntegrity upgradeGraph

194192 withSpinner "Checking existence of HEAD vertex" $

195− void $ getHeadVertex obDir -- HEAD vertex must be present.

193+ void $ getHeadVertex obDir

196194

195+-- | Create an edge from HEAD vertex to the hash corresponding to the Git

196+-- working copy. The HEAD vertex must already exist.

197197createMigrationEdgeFromHEAD :: MonadObelisk m => FilePath -> m ()

198198createMigrationEdgeFromHEAD obDir = do

199199 headHash <- getHeadVertex obDir

200200 wcHash <- getDirectoryHash migrationIgnore obDir

201201 if (headHash == wcHash)

202202 then

203− putLog Warning "No migration necessary (working copy has not changed from HEAD)"

203+ putLog Warning "No migration necessary (working copy has the same hash as that of HEAD)"

204204 else do

205− -- TODO: Add `ob internal create-migration --backfill=n` do it for all revisions.

206− -- See the failure condition in getHeadVertex

207205 writeEdge (migrationDir obDir) graphNames headHash wcHash >>= \case

208206 Nothing ->

209207 putLog Warning "No migration was created"

lib/command/src/Obelisk/Command/Upgrade/Hash.hs+8−8

@@ -3,6 +3,7 @@

33{-# LANGUAGE OverloadedStrings #-}

44{-# LANGUAGE ScopedTypeVariables #-}

55{-# LANGUAGE TupleSections #-}

6+-- | Hash a git repo or arbitrary directory using nix-hash.

67module Obelisk.Command.Upgrade.Hash

78 ( getDirectoryHash

89 , getHashAtGitRevision

@@ -33,20 +34,20 @@ import Obelisk.Migration

3334-- * .git directory

3435-- * untracked Git files

3536-- * ignored Git files

37+-- * empty directories

3638--

37−-- Uses the same predictive algorithm that Nix (`nix hash-path`).

39+-- Uses the same predictive algorithm as that of Nix (`nix hash-path`).

3840--

3941-- This function will do a full copy of the directory to a temporary location before

4042-- computing the hash. Because it will be deleting the files in exclude list, and

41−-- other files if the directory is a git repo. This needs to be done as `nix hash-path`

42−-- doesn't support taking an excludes list.

43+-- other files if the directory is a git repo, which needs to be done as `nix

44+-- hash-path` doesn't support taking an excludes list.

4345getDirectoryHash :: MonadObelisk m => [FilePath] -> FilePath -> m Hash

4446getDirectoryHash excludes dir = withSystemTempDirectory "obelisk-hash-" $ \tmpDir -> do

4547 withSpinnerNoTrail (T.pack $ "Copying " <> dir <> " to " <> tmpDir) $ do

4648 runProc $ copyDir dir tmpDir

4749 getDirectoryHashDestructive excludes tmpDir

4850

49−-- Do /not/ call this directly! Call `getDirectoryHash` instead.

5051getDirectoryHashDestructive :: MonadObelisk m => [FilePath] -> FilePath -> m Hash

5152getDirectoryHashDestructive excludes dir = do

5253 liftIO (doesDirectoryExist $ dir </> ".git") >>= \case

@@ -91,7 +92,7 @@ nixHash dir = withSpinnerNoTrail "Running `nix hash-path`" $

9192

9293-- | Clean up the following files in the git working copy

9394--

94−-- * Paths ignored by .gitignored, but still present in the filesystem

95+-- * Paths ignored by .gitignore, and still present

9596-- * Untracked files (not added to git index)

9697-- * Any empty directories (these are not tracked by git)

9798--

@@ -100,9 +101,8 @@ tidyUpGitWorkingCopy :: MonadObelisk m => FilePath -> m ()

100101tidyUpGitWorkingCopy dir = withSpinnerNoTrail "Tidying up git working copy" $ do

101102 ignored <- gitLsFiles dir ["--ignored", "--exclude-standard", "--others"]

102103 untracked <- gitLsFiles dir ["--exclude-standard", "--others"]

103− putLog Debug $ T.pack $ "Found " <> show (length ignored) <> " ignored files."

104− putLog Debug $ T.pack $ "Untracked:\n" <> unlines untracked

105− putLog Debug $ T.pack $ "Ignored:\n" <> unlines ignored

104+ putLog Debug $ T.pack $ "Ignored: " <> show (length ignored) <> " files."

105+ putLog Debug $ T.pack $ "Untracked files:\n" <> unlines untracked

106106 withSpinnerNoTrail "Removing untracked and ignored files" $ do

107107 forM_ (fmap (dir </>) $ ignored <> untracked) $

108108 liftIO . removePathForcibly

lib/migration/src/Obelisk/Migration.hs+4−4

@@ -106,7 +106,7 @@ ensureGraphIntegrity m = do

106106 graph <- fmap adjacencyMap $ getDag $ _migration_graph m

107107 firstVertex <- getFirst $ _migration_graph m

108108 let

109− traverseFrom visited acc start = case Map.lookup start graph of

109+ visitFrom visited acc start = case Map.lookup start graph of

110110 Nothing -> pure ()

111111 Just adjs -> void $ flip traverse (Set.toList adjs) $ \adj -> do

112112 acc' <- fmap (mappend acc) $ getAction m (start, adj)

@@ -115,14 +115,14 @@ ensureGraphIntegrity m = do

115115 Just adjAcc -> if acc' == adjAcc

116116 then pure visited

117117 else throwM $ NonEquivalentPaths start adj

118− traverseFrom visited' acc' adj

118+ visitFrom visited' acc' adj

119119 -- We only check all paths from the _first_ vertex; it is not necessary to

120120 -- check all paths between _all_ pairs of vertices as that can be proved by

121121 -- induction, as long as there is exactly one first vertex (which we check on

122122 -- further above).

123− traverseFrom mempty mempty firstVertex

123+ visitFrom mempty mempty firstVertex

124124

125−-- | Find the concataneted actions between two vertices

125+-- | Find the concatenated actions between two vertices

126126--

127127-- All paths between the vertices must have the same mappend'ed action;

128128-- otherwise this will throw.

migration/3b614d291e262d0f281b54ff42a6bb66-2e9a04a228106f62128ea5bd19d6b25e/obelisk-handoffnew file

No changes to the content.

migration/3b614d291e262d0f281b54ff42a6bb66-2e9a04a228106f62128ea5bd19d6b25e/obelisk-upgradenew file

No changes to the content.