b65bab9 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

command: Add thunk v5 to include src.nix

b65bab9Elliot Cameron7 years ago

lib/command/src/Obelisk/Command/Project.hs+1−10

compare with master

unifiedsplit

@@ -14,7 +14,6 @@ module Obelisk.Command.Project

14 , obeliskDirName

15 , projectShell

16 , toImplDir

17− , toNixPath

18 , toObeliskDir

17 , toObeliskDir

19 , withProjectRoot

18 , withProjectRoot

20 ) where

19 ) where

@@ -29,7 +28,6 @@ import Data.Bits

29import qualified Data.ByteString.Lazy as BSL

28import qualified Data.ByteString.Lazy as BSL

30import Data.Default (def)

29import Data.Default (def)

31import Data.Function ((&), on)

30import Data.Function ((&), on)

32−import Data.List (isInfixOf)

33import Data.Map (Map)

31import Data.Map (Map)

34import Data.Text (Text)

32import Data.Text (Text)

35import qualified Data.Text as T

33import qualified Data.Text as T

@@ -50,7 +48,7 @@ import Obelisk.App (MonadObelisk)

50import Obelisk.CliApp

48import Obelisk.CliApp

51import Obelisk.Command.Nix

49import Obelisk.Command.Nix

52import Obelisk.Command.Thunk

50import Obelisk.Command.Thunk

53−import Obelisk.Command.Utils (nixExePath, nixBuildExePath)

51+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath)

55--TODO: Make this module resilient to random exceptions

53--TODO: Make this module resilient to random exceptions

@@ -249,13 +247,6 @@ filePermissionIsSafe s umask = not fileWorldWritable && fileGroupWritable <= uma

249 fileGroupWritable = fileMode s .&. 0o020 == 0o020

247 fileGroupWritable = fileMode s .&. 0o020 == 0o020

250 umaskGroupWritable = umask .&. 0o020 == 0

248 umaskGroupWritable = umask .&. 0o020 == 0

251

249

252−-- | Nix syntax requires relative paths to be prefixed by @./@ or

253−-- @../@. This will make a 'FilePath' that can be embedded in a Nix

254−-- expression.

255−toNixPath :: FilePath -> FilePath

256−toNixPath root | "/" `isInfixOf` root = root

257− | otherwise = "./" <> root

258−

259nixShellRunConfig :: MonadObelisk m => FilePath -> Bool -> Maybe String -> m NixShellConfig

250nixShellRunConfig :: MonadObelisk m => FilePath -> Bool -> Maybe String -> m NixShellConfig

260nixShellRunConfig root isPure command = do

251nixShellRunConfig root isPure command = do

261 nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $

252 nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $

lib/command/src/Obelisk/Command/Thunk.hs+69−21

@@ -38,6 +38,7 @@ import Data.Maybe

38import Data.Set (Set)

39import qualified Data.Set as Set

40import Data.String.Here.Interpolated (i)

41+import Data.String.Here.Uninterpolated (here)

41import Data.Text (Text)

42import Data.Text (Text)

42import qualified Data.Text as T

43import qualified Data.Text as T

43import Data.Text.Encoding

44import Data.Text.Encoding

@@ -479,8 +480,9 @@ setThunk thunkConfig target gs branch = do

479-- This tool will only ever produce the newest one when it writes a thunk.

480-- This tool will only ever produce the newest one when it writes a thunk.

480gitHubThunkSpecs :: NonEmpty ThunkSpec

481gitHubThunkSpecs :: NonEmpty ThunkSpec

481gitHubThunkSpecs =

482gitHubThunkSpecs =

482− gitHubThunkSpecV4 :|

483+ gitHubThunkSpecV5 :|

484+ [ gitHubThunkSpecV4

483− [ gitHubThunkSpecV3

485+ , gitHubThunkSpecV3

484 , gitHubThunkSpecV2

486 , gitHubThunkSpecV2

485 , gitHubThunkSpecV1

487 , gitHubThunkSpecV1

486 ]

488 ]

@@ -535,15 +537,31 @@ gitHubThunkSpecV4 = legacyGitHubThunkSpec "github-v4" $ T.unlines

535legacyGitHubThunkSpec :: Text -> Text -> ThunkSpec

537legacyGitHubThunkSpec :: Text -> Text -> ThunkSpec

536legacyGitHubThunkSpec name loader = ThunkSpec name $ Map.fromList

538legacyGitHubThunkSpec name loader = ThunkSpec name $ Map.fromList

537 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)

539 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)

538− , ("github.json" , ThunkFileSpec_Ptr $ parseJsonObject $ parseThunkPtr $ \v ->

540+ , ("github.json" , ThunkFileSpec_Ptr parseGitHubJsonBytes)

539− ThunkSource_GitHub <$> parseGitHubSource v <|> ThunkSource_Git <$> parseGitSource v)

540 , (attrCacheFileName, ThunkFileSpec_AttrCache)

541 , (attrCacheFileName, ThunkFileSpec_AttrCache)

541 ]

542 ]

542

543

544+gitHubThunkSpecV5 :: ThunkSpec

545+gitHubThunkSpecV5 = mkThunkSpec "github-v5" "github.json" parseGitHubJsonBytes [here|

546+# DO NOT HAND-EDIT THIS FILE

547+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:

548+ if !fetchSubmodules && !private then builtins.fetchTarball {

549+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;

550+ } else (import <nixpkgs> {}).fetchFromGitHub {

551+ inherit owner repo rev sha256 fetchSubmodules private;

552+ };

553+in if builtins.pathExists ./_ then ./_ else fetch (builtins.fromJSON (builtins.readFile ./github.json))

554+|]

555+

556+parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

557+parseGitHubJsonBytes = parseJsonObject $ parseThunkPtr $ \v ->

558+ ThunkSource_GitHub <$> parseGitHubSource v <|> ThunkSource_Git <$> parseGitSource v

559+

543gitThunkSpecs :: NonEmpty ThunkSpec

560gitThunkSpecs :: NonEmpty ThunkSpec

544gitThunkSpecs =

561gitThunkSpecs =

545− gitThunkSpecV4 :|

562+ gitThunkSpecV5 :|

563+ [ gitThunkSpecV4

546− [ gitThunkSpecV3

564+ , gitThunkSpecV3

547 , gitThunkSpecV2

565 , gitThunkSpecV2

548 , gitThunkSpecV1

566 , gitThunkSpecV1

549 ]

567 ]

@@ -604,10 +622,44 @@ gitThunkSpecV4 = legacyGitThunkSpec "git-v4" $ T.unlines

604legacyGitThunkSpec :: Text -> Text -> ThunkSpec

622legacyGitThunkSpec :: Text -> Text -> ThunkSpec

605legacyGitThunkSpec name loader = ThunkSpec name $ Map.fromList

623legacyGitThunkSpec name loader = ThunkSpec name $ Map.fromList

606 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)

624 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)

607− , ("git.json" , ThunkFileSpec_Ptr $ parseJsonObject $ parseThunkPtr $ fmap ThunkSource_Git . parseGitSource)

625+ , ("git.json" , ThunkFileSpec_Ptr parseGitJsonBytes)

608 , (attrCacheFileName, ThunkFileSpec_AttrCache)

626 , (attrCacheFileName, ThunkFileSpec_AttrCache)

609 ]

627 ]

610

628

629+gitThunkSpecV5 :: ThunkSpec

630+gitThunkSpecV5 = mkThunkSpec "git-v5" "git.json" parseGitJsonBytes [here|

631+# DO NOT HAND-EDIT THIS FILE

632+let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:

633+ let realUrl = let firstChar = builtins.substring 0 1 url; in

634+ if firstChar == "/" then /. + url

635+ else if firstChar == "." then ./. + url

636+ else url;

637+ in if !fetchSubmodules && private then builtins.fetchGit {

638+ url = realUrl; inherit rev;

639+ ${if branch == null then null else "ref"} = branch;

640+ } else (import <nixpkgs> {}).fetchgit {

641+ url = realUrl; inherit rev sha256;

642+ };

643+in if builtins.pathExists ./_ then ./_ else fetch (builtins.fromJSON (builtins.readFile ./git.json))

644+|]

645+

646+parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

647+parseGitJsonBytes = parseJsonObject $ parseThunkPtr $ fmap ThunkSource_Git . parseGitSource

648+

649+mkThunkSpec :: Text -> FilePath -> (LBS.ByteString -> Either String ThunkPtr) -> Text -> ThunkSpec

650+mkThunkSpec name jsonFileName parser srcNix = ThunkSpec name $ Map.fromList

651+ [ ("default.nix", ThunkFileSpec_FileMatches defaultNixViaSrc)

652+ , ("src.nix", ThunkFileSpec_FileMatches srcNix)

653+ , (jsonFileName, ThunkFileSpec_Ptr parser)

654+ , (attrCacheFileName, ThunkFileSpec_AttrCache)

655+ ]

656+ where

657+ defaultNixViaSrc = [here|

658+# DO NOT HAND-EDIT THIS FILE

659+import (import ./src.nix)

660+|]

661+

662+

611parseJsonObject :: (Aeson.Object -> Aeson.Parser a) -> LBS.ByteString -> Either String a

663parseJsonObject :: (Aeson.Object -> Aeson.Parser a) -> LBS.ByteString -> Either String a

612parseJsonObject p bytes = Aeson.parseEither p =<< Aeson.eitherDecode bytes

664parseJsonObject p bytes = Aeson.parseEither p =<< Aeson.eitherDecode bytes

613

665

@@ -731,15 +783,15 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

731 Right (ThunkData_Packed (_, tptr)) -> do

783 Right (ThunkData_Packed (_, tptr)) -> do

732 let (thunkParent, thunkName) = splitFileName thunkDir

784 let (thunkParent, thunkName) = splitFileName thunkDir

733 withTempDirectory thunkParent thunkName $ \tmpRepo -> do

785 withTempDirectory thunkParent thunkName $ \tmpRepo -> do

734− let obGitDir = tmpRepo </> ".git" </> "obelisk"

786+ let

735− s = case _thunkPtr_source tptr of

787+ s = case _thunkPtr_source tptr of

736− ThunkSource_GitHub s' -> forgetGithub False s'

788+ ThunkSource_GitHub s' -> forgetGithub False s'

737− ThunkSource_Git s' -> s'

789+ ThunkSource_Git s' -> s'

738 withSpinner' ("Fetching thunk " <> T.pack thunkName)

790 withSpinner' ("Fetching thunk " <> T.pack thunkName)

739 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

791 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

740 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo

792 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo

741 git $ [ "clone" ]

793 git $ [ "clone" ]

742− ++ ("--recursive" <$ guard (_gitSource_fetchSubmodules s))

794+ ++ ["--recursive" | _gitSource_fetchSubmodules s]

743 ++ [ T.unpack $ gitUriToText $ _gitSource_url s ]

795 ++ [ T.unpack $ gitUriToText $ _gitSource_url s ]

744 ++ do branch <- maybeToList $ _gitSource_branch s

796 ++ do branch <- maybeToList $ _gitSource_branch s

745 [ "--branch", T.unpack $ untagName branch ]

797 [ "--branch", T.unpack $ untagName branch ]

@@ -747,13 +799,9 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

747 when (_gitSource_fetchSubmodules s) $

799 when (_gitSource_fetchSubmodules s) $

748 git ["submodule", "update", "--recursive", "--init"]

800 git ["submodule", "update", "--recursive", "--init"]

749

801

750− liftIO $ createDirectory obGitDir

802+ let unpackedPath = thunkDir </> unpackedDirName

751− callProcessAndLogOutput (Notice, Error) $

803+ liftIO $ createDirectoryIfMissing True (takeDirectory unpackedPath)

752− proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]

753− callProcessAndLogOutput (Notice, Error) $

804+ callProcessAndLogOutput (Notice, Error) $ proc mvPath [tmpRepo, unpackedPath]

754− proc rmPath ["-r", thunkDir]

755− callProcessAndLogOutput (Notice, Error) $

756− proc "mv" ["-T", tmpRepo, thunkDir]

757

805

758--TODO: add a rollback mode to pack to the original thunk

806--TODO: add a rollback mode to pack to the original thunk

759packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr

807packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr

@@ -766,8 +814,8 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire

766 Right (ThunkData_Checkout _) -> do

814 Right (ThunkData_Checkout _) -> do

767 withSpinner' ("Packing thunk " <> T.pack thunkDir)

815 withSpinner' ("Packing thunk " <> T.pack thunkDir)

768 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

816 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

769− thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir (_thunkConfig_private thunkConfig)

817+ thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) (thunkDir </> unpackedDirName) (_thunkConfig_private thunkConfig)

770− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", thunkDir] -- thunkDir may be a symlink

818+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir </> unpackedDirName] -- thunkDir may be a symlink

771 createThunk thunkDir thunkPtr

819 createThunk thunkDir thunkPtr

772 pure thunkPtr

820 pure thunkPtr

773

821

lib/command/src/Obelisk/Command/Utils.hs+14−2

@@ -10,19 +10,20 @@ module Obelisk.Command.Utils where

10import Control.Applicative hiding (many)

11import Control.Monad.Except

12import Data.Bool (bool)

13−import qualified Text.Megaparsec.Char.Lexer as ML

14import Data.Bifunctor

13import Data.Bifunctor

15import Data.Char

14import Data.Char

16import Data.Either

15import Data.Either

17−import Data.Semigroup ((<>))

16+import Data.List (isInfixOf)

18import Data.Map (Map)

17import Data.Map (Map)

19import qualified Data.Map as M

18import qualified Data.Map as M

20import Data.Maybe (maybeToList)

19import Data.Maybe (maybeToList)

20+import Data.Semigroup ((<>))

21import Data.Text (Text)

22import qualified Data.Text as T

23import Data.Void (Void)

24import System.Exit (ExitCode)

25import System.Which (staticWhich)

26+import qualified Text.Megaparsec.Char.Lexer as ML

26import Text.Megaparsec as MP

27import Text.Megaparsec as MP

27import Text.Megaparsec.Char as MP

28import Text.Megaparsec.Char as MP

@@ -32,6 +33,9 @@ import Obelisk.CliApp

32cp :: FilePath

33cp :: FilePath

33cp = $(staticWhich "cp")

34cp = $(staticWhich "cp")

36+mvPath :: FilePath

37+mvPath = $(staticWhich "mv")

38+

35rmPath :: FilePath

39rmPath :: FilePath

36rmPath = $(staticWhich "rm")

40rmPath = $(staticWhich "rm")

@@ -50,6 +54,14 @@ nixBuildExePath = $(staticWhich "nix-build")

50jreKeyToolPath :: FilePath

54jreKeyToolPath :: FilePath

51jreKeyToolPath = $(staticWhich "keytool")

55jreKeyToolPath = $(staticWhich "keytool")

57+-- | Nix syntax requires relative paths to be prefixed by @./@ or

58+-- @../@. This will make a 'FilePath' that can be embedded in a Nix

59+-- expression.

60+toNixPath :: FilePath -> FilePath

61+toNixPath root | "/" `isInfixOf` root = root

62+ | otherwise = "./" <> root

63+

64+

53-- Check whether the working directory is clean

65-- Check whether the working directory is clean

54checkGitCleanStatus :: MonadObelisk m => FilePath -> Bool -> m Bool

66checkGitCleanStatus :: MonadObelisk m => FilePath -> Bool -> m Bool

55checkGitCleanStatus repo withIgnored = do

67checkGitCleanStatus repo withIgnored = do