30a1f15 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Cleanup code

30a1f15Sridhar Ratnakumar8 years ago

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

compare with master

unifiedsplit

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

4module Obelisk.CliApp.Demo where

6import Control.Concurrent (threadDelay)

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

7+import Control.Monad.IO.Class

8−import Control.Monad.Reader (MonadIO)

9import Data.Semigroup ((<>))

8import Data.Semigroup ((<>))

10import qualified Data.Text as T

9import qualified Data.Text as T

11import System.Process (proc)

10import System.Process (proc)

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

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

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

17import Control.Monad.IO.Class

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

19−import Control.Monad.Reader (MonadIO)

20import Data.IORef

19import Data.IORef

21import qualified Data.List as L

20import qualified Data.List as L

22import Data.Maybe (isNothing)

21import Data.Maybe (isNothing)

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

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

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

37--

36--

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.

39--

38--

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

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

41−-- leave a trail either).

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

42withSpinnerNoTrail

41withSpinnerNoTrail

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

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

44 => Text -> m a -> m a

43 => Text -> m a -> m a

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

80 ( TerminalString_Colorized Green "✔"

79 ( TerminalString_Colorized Green "✔"

81 , mkTrail <*> pure result

80 , mkTrail <*> pure result

82 )

81 )

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

84 pushSpinner (flag, old) =

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

86 , null old -- Is empty?

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

133type SpinnerTheme = [Text]

134

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

136−spinnerCircleHalves :: SpinnerTheme

136+_spinnerCircleHalves :: SpinnerTheme

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

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

138

139spinnerMoon :: SpinnerTheme

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

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

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

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

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

254

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

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

256mkObeliskConfig :: IO Obelisk

257mkObeliskConfig = do

258 cliArgs <- getArgs

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

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

270 return $ isTerm && not inShellCompletion

271

272−-- For use from development obelisk repls

272+-- | For use from development obelisk repls

273--

274-- Example:

275-- > runCommand $ someFuncInMonadObelisk ...

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

306 HandOff_Decide f impl as -> do

307 withSpinner' "Deciding whether to handoff"

308 (Just $ bool

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

309+ "Continuing in ambient obelisk without handing off"

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

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

311 True -> mainWithHandOff argsCfg $ HandOff_Yes impl as

312 False -> mainWithHandOff argsCfg $ HandOff_No as

313 HandOff_No as -> do

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

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

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

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

89 ambientHash <- getLast (_migration_graph m)

90− unless (hasVertex ambientHash m) $

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

92 return (m, ambientHash)

90 return (m, ambientHash)

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

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

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

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

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

109 Just v -> pure v

107 Just v -> pure v

110 Nothing ->

108 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."

112

110

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

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

114updateObelisk project gitBranch =

112updateObelisk project gitBranch =

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

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

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

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

117 fromHash <- computeVertexHash obImpl

115 fromHash <- computeVertexHash obImpl

118 callProcessAndLogOutput (Debug, Debug) $

116 callProcessAndLogOutput (Debug, Debug) $

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

123

121

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

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

125handOffToNewOb project fromHash = do

123handOffToNewOb 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) $

127 findProjectObeliskCommand project >>= \case

125 findProjectObeliskCommand project >>= \case

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

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

129 Just impl -> pure impl

127 Just impl -> pure impl

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

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

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

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

132

130

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

131migrateObelisk :: 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

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

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

136 toHash <- computeVertexHash obImpl

134 toHash <- computeVertexHash obImpl

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

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

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

192 withSpinner "Checking graph integrity" $

190 withSpinner "Checking graph integrity" $

193 ensureGraphIntegrity upgradeGraph

191 ensureGraphIntegrity upgradeGraph

194 withSpinner "Checking existence of HEAD vertex" $

192 withSpinner "Checking existence of HEAD vertex" $

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

193+ void $ getHeadVertex obDir

196

194

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

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

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

198createMigrationEdgeFromHEAD obDir = do

199 headHash <- getHeadVertex obDir

200 wcHash <- getDirectoryHash migrationIgnore obDir

201 if (headHash == wcHash)

202 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)"

204 else do

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

206− -- See the failure condition in getHeadVertex

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

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

208 Nothing ->

206 Nothing ->

209 putLog Warning "No migration was created"

207 putLog Warning "No migration was created"

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

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

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TupleSections #-}

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

6module Obelisk.Command.Upgrade.Hash

7module Obelisk.Command.Upgrade.Hash

7 ( getDirectoryHash

8 ( getDirectoryHash

8 , getHashAtGitRevision

9 , getHashAtGitRevision

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

33-- * .git directory

34-- * .git directory

34-- * untracked Git files

35-- * untracked Git files

35-- * ignored Git files

36-- * ignored Git files

37+-- * empty directories

36--

38--

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

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

38--

40--

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

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

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

42-- 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`

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

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

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

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

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

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

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

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

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

46 runProc $ copyDir dir tmpDir

48 runProc $ copyDir dir tmpDir

47 getDirectoryHashDestructive excludes tmpDir

49 getDirectoryHashDestructive excludes tmpDir

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

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

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

51getDirectoryHashDestructive excludes dir = do

52getDirectoryHashDestructive excludes dir = do

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

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

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

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

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

93--

94--

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

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

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

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

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

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

97--

98--

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

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

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

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

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

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

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

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

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

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

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

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

106 withSpinnerNoTrail "Removing untracked and ignored files" $ do

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

108 liftIO . removePathForcibly

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

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

106 graph <- fmap adjacencyMap $ getDag $ _migration_graph m

107 firstVertex <- getFirst $ _migration_graph m

108 let

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

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

110 Nothing -> pure ()

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

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

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

115 Just adjAcc -> if acc' == adjAcc

116 then pure visited

117 else throwM $ NonEquivalentPaths start adj

118− traverseFrom visited' acc' adj

118+ visitFrom visited' acc' adj

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

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

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

122 -- further above).

123− traverseFrom mempty mempty firstVertex

123+ visitFrom mempty mempty firstVertex

124

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

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

126--

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

128-- 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.