baserock-schema 0.0.1.3 → 0.0.1.5
raw patch · 5 files changed
+297/−182 lines, 5 filesdep +gitlab-apidep +lensdep +unordered-containers
Dependencies added: gitlab-api, lens, unordered-containers
Files
- ChangeLog.md +6/−0
- app/Main.hs +40/−2
- baserock-schema.cabal +9/−2
- src/Baserock/Schema/V9.hs +145/−83
- test/Spec.hs +97/−95
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for baserock-schema +## 0.0.1.5 (PreAlpha)++* Fix some schema issues.+* Add lens interfaces.+* Add example application using gitlab-api+ ## 0.0.1.0 (PreAlpha) * Add Basic Chunk, Stratum and System parsing for baserock definitions V9
app/Main.hs view
@@ -1,21 +1,44 @@-{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} import Baserock.Schema.V9+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8 import Control.Exception+import Control.Lens hiding (argument) import Control.Monad (when) import Control.Monad.Except import Data.Char (toUpper)-import System.Environment (getArgs)+import Data.HashMap.Strict+import Data.List+import qualified Data.Text as Text+import Data.Yaml+import Gitlab+import System.Environment (getEnv, getArgs) import System.Console.Docopt patterns :: Docopt patterns = [docopt| Usage:+ baserock bump-shas <stratum> baserock sanitize <system> |] getArgOrExit = getArgOrExitWith patterns +chunkLatest :: MonadGitlab m => Chunk -> m GitlabCommitData+chunkLatest = liftM2 getShaOfRef (toSignificantSuffix . _repo) _ref++bumpChunkSha :: MonadGitlab m => Chunk -> m Chunk+bumpChunkSha c = fmap (flip (sha ?~) c . commitId) . chunkLatest $ c++getAliases ybdconf = do+ ybdconf <- decodeFile ybdconf :: IO (Maybe Object)+ let Just (Object as) = join $ parseMaybe (flip (.:) "aliases") <$> ybdconf :: Maybe Value+ return $ fmap (\(String y) -> y) $ as++toSignificantSuffix = (!! 1) . Text.splitOn ":"+ main = do args <- parseArgsOrExit patterns =<< getArgs @@ -25,3 +48,18 @@ case s of Right r -> encodeSystemAST f r Left e -> throwIO e++ when (args `isPresent` command "bump-shas") $ do+ f <- args `getArgOrExit` (argument "stratum")+ envPrivateToken <- getEnv "GITLAB_PRIVATE_TOKEN"+ envBaseUrl <- getEnv "GITLAB_BASE_URL"++ aliases <- getAliases "ybd.conf"++ let gconf = GitlabConfig { glCredsUrl = BS8.pack envBaseUrl, glCredsToken = BS8.pack envPrivateToken }++ s <- either (error . show) id <$> decodeFileEither f+ let s2 = over (chunks . traverse . repo) (flip (foldrWithKey Text.replace) aliases) s+ r <- runGitlab gconf $ mapMOf (chunks . traverse) bumpChunkSha $ s2+ let s3 = over (chunks . traverse . repo) (flip (foldlWithKey' ((flip . (flip . ) . flip) Text.replace)) aliases) r+ BS.writeFile f (toPrettyYaml s3)
baserock-schema.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b6837e1fe21d79c10d9853821740047ab7d4a15eaee1668f814cb447afee0f08+-- hash: c8c8db858030e83a98af816533ab7595e6c4e6052ce82f2a8c9baaa249dac1af name: baserock-schema-version: 0.0.1.3+version: 0.0.1.5 synopsis: Baserock Definitions Schema description: Baserock Definitions Schema - Parsers, Printers, Encoders, Decoders, ASTs, Graphs and Traversals category: Data@@ -37,10 +37,12 @@ , base >=4.7 && <5 , bytestring , errors+ , lens , mtl , text , transformers , turtle+ , unordered-containers , yaml default-language: Haskell2010 @@ -58,10 +60,13 @@ , bytestring , docopt , errors+ , gitlab-api+ , lens , mtl , text , transformers , turtle+ , unordered-containers , yaml default-language: Haskell2010 @@ -81,9 +86,11 @@ , bytestring , errors , hspec+ , lens , mtl , text , transformers , turtle+ , unordered-containers , yaml default-language: Haskell2010
src/Baserock/Schema/V9.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- |@@ -14,24 +15,65 @@ module Baserock.Schema.V9 ( -- * Schema- ChunkInstructions (..),- Chunk (..),- Stratum (..),- StratumBD (..),- StratumInclude (..),- System (..),+ ChunkInstructions(..),+ Chunk(..),+ StratumBD(..),+ StratumInclude(..),+ Stratum(..),+ System(..), + -- * Lenses+ chunkInstructionsName,+ buildSystem,+ preConfigureCommands,+ configureCommands,+ postConfigureCommands,+ preBuildCommands,+ buildCommands,+ postBuildCommands,+ preInstallCommands,+ installCommands,+ postInstallCommands,++ chunkName,+ chunkMorph,+ repo,+ ref,+ sha,+ buildMode,+ chunkBuildSystem,++ stratumBDMorph,++ stratumName,+ stratumDescription,+ stratumBDs,+ chunks,++ stratumIncludeName,+ stratumIncludeMorph,++ systemName,+ systemDescription,+ arch,+ strata,+ configurationExtensions,+ -- * ASTs- + StratumAST, SystemAST, - decodeStratumAST,+ -- * Codecs+ encodeStratumAST,- decodeSystemAST,+ decodeStratumAST, encodeSystemAST,+ decodeSystemAST, - -- * toPrettyYaml+ -- * Misc+ + encodeFilePretty, ToPrettyYaml(..) ) where@@ -41,9 +83,11 @@ import Control.Applicative import Control.Error.Safe import Control.Error.Util+import Control.Lens.TH import Control.Monad import Control.Monad.Except import qualified Data.ByteString as BS+import Data.Ord import Data.List import Data.Maybe import Data.Monoid@@ -51,9 +95,9 @@ import Data.Yaml import Data.Yaml.Pretty -listElemCmp as x y = fromJust $ liftA2 compare (elemIndex x as) (elemIndex y as)+listElemCmp as x y = fromMaybe LT $ liftA2 compare (elemIndex x as) (elemIndex y as) -possibly f v = if v == mempty then mempty else [f .= v]+possibly f v = if v == mzero then mzero else [f .= v] class ToJSON a => ToPrettyYaml a where fieldOrder :: a -> [Text]@@ -64,24 +108,29 @@ toPrettyYaml :: a -> BS.ByteString toPrettyYaml x = encodePretty (setConfCompare (fieldCmp x) defConfig) x ---- ChunkInstructions ("chunk.morph")---+encodeFilePretty :: ToPrettyYaml a => FilePath -> a -> IO ()+encodeFilePretty f x = BS.writeFile f (toPrettyYaml x)++-- * ChunkInstructions+ data ChunkInstructions = ChunkInstructions {- chunkInstructionsName :: Text,- buildSystem :: Text,- preConfigureCommands :: [Text],- configureCommands :: [Text],- postConfigureCommands :: [Text],- preBuildCommands :: [Text],- buildCommands :: [Text],- postBuildCommands :: [Text],- preInstallCommands :: [Text],- installCommands :: [Text],- postInstallCommands :: [Text]+ _chunkInstructionsName :: Text,+ _buildSystem :: Text,+ _preConfigureCommands :: [Text],+ _configureCommands :: [Text],+ _postConfigureCommands :: [Text],+ _preBuildCommands :: [Text],+ _buildCommands :: [Text],+ _postBuildCommands :: [Text],+ _preInstallCommands :: [Text],+ _installCommands :: [Text],+ _postInstallCommands :: [Text] } deriving (Eq, Show) +$(makeLenses ''ChunkInstructions)+ instance FromJSON ChunkInstructions where- parseJSON = withObject "ChunkInstructions" $ \v -> ChunkInstructions+ parseJSON (Object v) = ChunkInstructions <$> v .: "name" <*> v .:? "build-system" .!= "manual" <*> v .:? "pre-configure-commands" .!= []@@ -96,16 +145,16 @@ instance ToJSON ChunkInstructions where toJSON x =- object $ ["name" .= chunkInstructionsName x, "kind" .= ("chunk" :: Text), "build-system" .= buildSystem x]- <> possibly "pre-configure-commands" (preConfigureCommands x)- <> possibly "configure-commands" (configureCommands x)- <> possibly "post-configure-commands" (postConfigureCommands x)- <> possibly "pre-build-commands" (preBuildCommands x)- <> possibly "build-commands" (buildCommands x)- <> possibly "post-build-commands" (postBuildCommands x)- <> possibly "pre-install-commands" (preInstallCommands x)- <> possibly "install-commands" (installCommands x)- <> possibly "post-install-commands" (postInstallCommands x)+ object $ ["name" .= _chunkInstructionsName x, "kind" .= ("chunk" :: Text), "build-system" .= _buildSystem x]+ <> possibly "pre-configure-commands" (_preConfigureCommands x)+ <> possibly "configure-commands" (_configureCommands x)+ <> possibly "post-configure-commands" (_postConfigureCommands x)+ <> possibly "pre-build-commands" (_preBuildCommands x)+ <> possibly "build-commands" (_buildCommands x)+ <> possibly "post-build-commands" (_postBuildCommands x)+ <> possibly "pre-install-commands" (_preInstallCommands x)+ <> possibly "install-commands" (_installCommands x)+ <> possibly "post-install-commands" (_postInstallCommands x) instance ToPrettyYaml ChunkInstructions where fieldOrder = const $ ["name", "kind", "build-system"]@@ -116,18 +165,20 @@ -- Stratum ("stratum.morph") data Chunk = Chunk {- chunkName :: Text,- chunkMorph :: Maybe Text,- repo :: Text,- ref :: Text,- sha :: Maybe Text,- buildMode :: Text,- chunkBuildSystem :: Text,- chunkBDs :: [Text]+ _chunkName :: Text,+ _chunkMorph :: Maybe Text,+ _repo :: Text,+ _ref :: Text,+ _sha :: Maybe Text,+ _buildMode :: Text,+ _chunkBuildSystem :: Text,+ _chunkBDs :: [Text] } deriving (Eq, Show) +$(makeLenses ''Chunk)+ instance FromJSON Chunk where- parseJSON = withObject "Chunk" $ \v -> Chunk+ parseJSON (Object v) = Chunk <$> v .: "name" <*> v .:? "morph" <*> v .: "repo"@@ -138,76 +189,87 @@ <*> v .:? "build-depends" .!= [] instance ToJSON Chunk where- toJSON x = object $ ["name" .= chunkName x, "repo" .= repo x, "ref" .= ref x, "sha" .= sha x]- <> possibly "morph" (chunkMorph x)- <> possibly "build-mode" (buildMode x)- <> possibly "build-system" (chunkBuildSystem x)- <> possibly "build-depends" (chunkBDs x)+ toJSON x = object $ ["name" .= _chunkName x, "repo" .= _repo x, "ref" .= _ref x, "sha" .= _sha x]+ <> possibly "morph" (_chunkMorph x)+ <> (if _buildMode x == "staging" then mempty else ["buildmode" .= _buildMode x])+ <> (if _chunkBuildSystem x == "manual" then mempty else ["build-system" .= _chunkBuildSystem x])+ <> possibly "build-depends" (_chunkBDs x) instance ToPrettyYaml Chunk where fieldOrder = const ["name", "morph", "repo", "ref", "sha", "build-mode", "build-system", "build-depends"] data StratumBD = StratumBD {- stratumBDMorph :: Text+ _stratumBDMorph :: Text } deriving (Eq, Show) +$(makeLenses ''StratumBD)+ instance FromJSON StratumBD where- parseJSON = withObject "StratumBD" $ \v -> StratumBD+ parseJSON (Object v) = StratumBD <$> v .: "morph" instance ToJSON StratumBD where- toJSON x = object ["morph" .= stratumBDMorph x]+ toJSON x = object ["morph" .= _stratumBDMorph x] +instance ToPrettyYaml StratumBD where+ fieldOrder = const ["morph"]+ data Stratum = Stratum {- stratumName :: Text,- stratumDescription :: Maybe Text,- stratumBDs :: [StratumBD],- chunks :: [Chunk]+ _stratumName :: Text,+ _stratumDescription :: Maybe Text,+ _stratumBDs :: [StratumBD],+ _chunks :: [Chunk] } deriving (Eq, Show) +$(makeLenses ''Stratum)+ instance FromJSON Stratum where- parseJSON = withObject "Stratum" $ \v -> Stratum+ parseJSON (Object v) = Stratum <$> v .: "name" <*> v .:? "description" <*> v .:? "build-depends" .!= [] <*> v .: "chunks" instance ToJSON Stratum where- toJSON x = object $ ["name" .= stratumName x, "kind" .= ("stratum" :: Text), "chunks" .= chunks x]- <> possibly "description" (stratumDescription x)- <> possibly "build-depends" (stratumBDs x)+ toJSON x = object $ ["name" .= _stratumName x, "kind" .= ("stratum" :: Text), "chunks" .= _chunks x]+ <> possibly "description" (_stratumDescription x)+ <> possibly "build-depends" (_stratumBDs x) instance ToPrettyYaml Stratum where- fieldOrder = const ["name", "kind", "morph", "repo", "ref", "sha", "build-mode", "build-system", "build-depends", "chunks"]+ fieldOrder = const ["name", "kind", "description", "morph", "repo", "ref", "sha", "build-mode", "build-system", "build-depends", "chunks"] -- System ("system.morph") data StratumInclude = StratumInclude {- stratumIncludeName :: Text,- stratumIncludeMorph :: Text+ _stratumIncludeName :: Text,+ _stratumIncludeMorph :: Text } deriving (Eq, Show) +$(makeLenses ''StratumInclude)+ instance FromJSON StratumInclude where- parseJSON = withObject "StratumInclude" $ \v -> StratumInclude+ parseJSON (Object v) = StratumInclude <$> v .: "name" <*> v .: "morph" instance ToJSON StratumInclude where- toJSON x = object ["name" .= stratumIncludeName x, "morph" .= stratumIncludeMorph x]+ toJSON x = object ["name" .= _stratumIncludeName x, "morph" .= _stratumIncludeMorph x] instance ToPrettyYaml StratumInclude where fieldOrder = const ["name", "morph"] data System = System {- systemName :: Text,- systemDescription :: Maybe Text,- arch :: Text,- strata :: [StratumInclude],- configurationExtensions :: [Text]+ _systemName :: Text,+ _systemDescription :: Maybe Text,+ _arch :: Text,+ _strata :: [StratumInclude],+ _configurationExtensions :: [Text] } deriving (Eq, Show) +$(makeLenses ''System)+ instance FromJSON System where- parseJSON = withObject "System" $ \v -> System+ parseJSON (Object v) = System <$> v .: "name" <*> v .:? "description" <*> v .: "arch"@@ -215,8 +277,8 @@ <*> v .: "configuration-extensions" instance ToJSON System where- toJSON x = object $ ["name" .= systemName x, "kind" .= ("system" :: Text), "arch" .= arch x, "strata" .= strata x, "configuration-extensions" .= configurationExtensions x]- <> possibly "description" (systemDescription x)+ toJSON x = object $ ["name" .= _systemName x, "kind" .= ("system" :: Text), "arch" .= _arch x, "strata" .= _strata x, "configuration-extensions" .= _configurationExtensions x]+ <> possibly "description" (_systemDescription x) instance ToPrettyYaml System where fieldOrder = const $ ["name", "morph", "kind", "description", "arch", "strata", "configuration-extensions"]@@ -232,22 +294,22 @@ (ExceptT . decodeFileEither $ x) >>= splitK return (mapM (splitK return decoder) . selector) decodeStratumAST :: FilePath -> IO (Either ParseException StratumAST)-decodeStratumAST = decodeASTWith (fmap unpack . mapMaybe chunkMorph . chunks) (ExceptT . decodeFileEither)+decodeStratumAST = decodeASTWith (fmap unpack . mapMaybe _chunkMorph . _chunks) (ExceptT . decodeFileEither) decodeSystemAST :: FilePath -> IO (Either ParseException SystemAST)-decodeSystemAST = decodeASTWith (fmap (unpack . stratumIncludeMorph) . strata) (ExceptT . decodeStratumAST)+decodeSystemAST = decodeASTWith (fmap (unpack . _stratumIncludeMorph) . _strata) (ExceptT . decodeStratumAST) -- Encoders encodeStratumAST :: FilePath -> StratumAST -> IO () encodeStratumAST f (x, as) = do- BS.writeFile f (toPrettyYaml x)- forM_ as $ \(i, j) -> BS.writeFile i (toPrettyYaml j)+ encodeFilePretty f x+ forM_ as $ uncurry encodeFilePretty encodeSystemAST :: FilePath -> SystemAST -> IO () encodeSystemAST f (x, as) = do- BS.writeFile f (toPrettyYaml x)- forM_ as $ \(i, j) -> encodeStratumAST i j+ encodeFilePretty f x+ forM_ as $ uncurry encodeStratumAST -- Utility @@ -256,9 +318,9 @@ stratumGraph :: Stratum -> Either BaserockGraphException (Graph Chunk) stratumGraph s = right edges $ sequence $ runExceptT $ do- x <- ExceptT (fmap Right $ chunks s)- y <- ExceptT (fmap Right $ chunkBDs x)- z <- failWith (NoExistChunkBD x y) $ find ((== y) . chunkName) (chunks s)+ x <- ExceptT (fmap Right $ _chunks s)+ y <- ExceptT (fmap Right $ _chunkBDs x)+ z <- failWith (NoExistChunkBD x y) $ find ((== y) . _chunkName) (_chunks s) return (z, x) -- V9 is non-regular in that graphs of Strata can be derived purely from the Stratum itself
test/Spec.hs view
@@ -10,110 +10,110 @@ import Turtle v9_mock_chunk_instructions_brie_cc = ChunkInstructions {- chunkInstructionsName = "brie-cc",- buildSystem = "autotools",- preConfigureCommands = ["make configure"],- configureCommands = [],- postConfigureCommands = [],- preBuildCommands = [],- buildCommands = ["make all"],- postBuildCommands = [],- preInstallCommands = [],- installCommands = [],- postInstallCommands = []+ _chunkInstructionsName = "brie-cc",+ _buildSystem = "autotools",+ _preConfigureCommands = ["make configure"],+ _configureCommands = [],+ _postConfigureCommands = [],+ _preBuildCommands = [],+ _buildCommands = ["make all"],+ _postBuildCommands = [],+ _preInstallCommands = [],+ _installCommands = [],+ _postInstallCommands = [] } v9_mock_chunk_instructions_linux_api_headers = ChunkInstructions {- chunkInstructionsName = "linux-api-headers",- buildSystem = "autotools",- preConfigureCommands = ["make configure"],- configureCommands = [],- postConfigureCommands = [],- preBuildCommands = [],- buildCommands = ["make all"],- postBuildCommands = [],- preInstallCommands = [],- installCommands = [],- postInstallCommands = []+ _chunkInstructionsName = "linux-api-headers",+ _buildSystem = "autotools",+ _preConfigureCommands = ["make configure"],+ _configureCommands = [],+ _postConfigureCommands = [],+ _preBuildCommands = [],+ _buildCommands = ["make all"],+ _postBuildCommands = [],+ _preInstallCommands = [],+ _installCommands = [],+ _postInstallCommands = [] } v9_mock_stratum_grilled_essential = Stratum {- stratumName = "grilled-essential",- stratumDescription = Nothing,- stratumBDs = [ ],- chunks = [ Chunk { chunkName = "brie-cc",- buildMode = "staging",- chunkBuildSystem = "manual",- repo = "gitlab:brie-cc",- chunkMorph = Just "quux/strata/grilled-essential/brie-cc.morph",- ref = "foo",- sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",- chunkBDs = [] },- Chunk { chunkName = "linux-api-headers", - buildMode = "staging",- chunkBuildSystem = "manual",- repo = "gitlab:kernel/linux-stable",- chunkMorph = Just "quux/strata/grilled-essential/linux-api-headers.morph",- ref = "bar",- sha = Just "9db87049dd8b357bf9be97f6394b5251e8606fe2",- chunkBDs = [ "brie-cc" ] } ]}+ _stratumName = "grilled-essential",+ _stratumDescription = Nothing,+ _stratumBDs = [ ],+ _chunks = [ Chunk { _chunkName = "brie-cc",+ _buildMode = "staging",+ _chunkBuildSystem = "manual",+ _repo = "gitlab:brie-cc",+ _chunkMorph = Just "quux/strata/grilled-essential/brie-cc.morph",+ _ref = "foo",+ _sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",+ _chunkBDs = [] },+ Chunk { _chunkName = "linux-api-headers", + _buildMode = "staging",+ _chunkBuildSystem = "manual",+ _repo = "gitlab:kernel/linux-stable",+ _chunkMorph = Just "quux/strata/grilled-essential/linux-api-headers.morph",+ _ref = "bar",+ _sha = Just "9db87049dd8b357bf9be97f6394b5251e8606fe2",+ _chunkBDs = [ "brie-cc" ] } ]} v9_mock_chunk_instructions_ccake = ChunkInstructions {- chunkInstructionsName = "ccake",- buildSystem = "autotools",- preConfigureCommands = ["make configure"],- configureCommands = [],- postConfigureCommands = [],- preBuildCommands = [],- buildCommands = ["make all"],- postBuildCommands = [],- preInstallCommands = [],- installCommands = [],- postInstallCommands = []+ _chunkInstructionsName = "ccake",+ _buildSystem = "autotools",+ _preConfigureCommands = ["make configure"],+ _configureCommands = [],+ _postConfigureCommands = [],+ _preBuildCommands = [],+ _buildCommands = ["make all"],+ _postBuildCommands = [],+ _preInstallCommands = [],+ _installCommands = [],+ _postInstallCommands = [] } v9_mock_chunk_instructions_sesame_sed = ChunkInstructions {- chunkInstructionsName = "sesame-sed",- buildSystem = "autotools",- preConfigureCommands = ["make configure"],- configureCommands = [],- postConfigureCommands = [],- preBuildCommands = [],- buildCommands = ["make all"],- postBuildCommands = [],- preInstallCommands = [],- installCommands = [],- postInstallCommands = []+ _chunkInstructionsName = "sesame-sed",+ _buildSystem = "autotools",+ _preConfigureCommands = ["make configure"],+ _configureCommands = [],+ _postConfigureCommands = [],+ _preBuildCommands = [],+ _buildCommands = ["make all"],+ _postBuildCommands = [],+ _preInstallCommands = [],+ _installCommands = [],+ _postInstallCommands = [] } v9_mock_stratum_core = Stratum {- stratumName = "core",- stratumDescription = Nothing,- stratumBDs = [ StratumBD { stratumBDMorph = "quux/strata/grilled-essential.morph" }],- chunks = [ Chunk { chunkName = "ccake",- buildMode = "staging",- chunkBuildSystem = "manual",- repo = "gitlab:upstream/ccake",- chunkMorph = Just "quux/strata/core/ccake.morph",- ref = "master",- sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",- chunkBDs = [] },- Chunk { chunkName = "sesame-sed", - buildMode = "staging",- chunkBuildSystem = "manual",- repo = "gitlab:upstream/sesame-sed",- chunkMorph = Just "quux/strata/core/sesame-sed.morph",- ref = "master",- sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",- chunkBDs = [ "ccake" ] } ]}+ _stratumName = "core",+ _stratumDescription = Nothing,+ _stratumBDs = [ StratumBD { _stratumBDMorph = "quux/strata/grilled-essential.morph" }],+ _chunks = [ Chunk { _chunkName = "ccake",+ _buildMode = "staging",+ _chunkBuildSystem = "manual",+ _repo = "gitlab:upstream/ccake",+ _chunkMorph = Just "quux/strata/core/ccake.morph",+ _ref = "master",+ _sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",+ _chunkBDs = [] },+ Chunk { _chunkName = "sesame-sed", + _buildMode = "staging",+ _chunkBuildSystem = "manual",+ _repo = "gitlab:upstream/sesame-sed",+ _chunkMorph = Just "quux/strata/core/sesame-sed.morph",+ _ref = "master",+ _sha = Just "0c3506aa4f33da7fc2fba0fd6b614bf8e861e3ba",+ _chunkBDs = [ "ccake" ] } ]} v9_mock_system_quux = System {- systemName = "quux-system-x86_32",- systemDescription = Nothing,- arch = "x86_32",- strata = [ StratumInclude { stratumIncludeName = "grilled-essential", stratumIncludeMorph = "quux/strata/grilled-essential.morph" },- StratumInclude { stratumIncludeName = "core", stratumIncludeMorph = "quux/strata/core.morph" } ],- configurationExtensions = ["extensions/smooth-and-creamy"]}+ _systemName = "quux-system-x86_32",+ _systemDescription = Nothing,+ _arch = "x86_32",+ _strata = [ StratumInclude { _stratumIncludeName = "grilled-essential", _stratumIncludeMorph = "quux/strata/grilled-essential.morph" },+ StratumInclude { _stratumIncludeName = "core", _stratumIncludeMorph = "quux/strata/core.morph" } ],+ _configurationExtensions = ["extensions/smooth-and-creamy"]} v9_mock_stratum_grilled_essential_ast = (v9_mock_stratum_grilled_essential, [("quux/strata/grilled-essential/brie-cc.morph", v9_mock_chunk_instructions_brie_cc),@@ -129,16 +129,18 @@ in_mock_definitions_v9 = bracket_ (cd "test/mock-definitions-v9") (cd "../../") +testDecodeAgainst x y = either (error . show) id <$> decodeFileEither x `shouldReturn` (Just y)+ main :: IO () main = hspec $ around_ in_mock_definitions_v9 $ do describe "Baserock.Schema.V9" $ do describe "ChunkInstructions" $ do it "decodes correctly" $ do- decodeFile "quux/strata/grilled-essential/brie-cc.morph" `shouldReturn` (Just v9_mock_chunk_instructions_brie_cc :: Maybe ChunkInstructions)- decodeFile "quux/strata/grilled-essential/linux-api-headers.morph" `shouldReturn` (Just v9_mock_chunk_instructions_linux_api_headers :: Maybe ChunkInstructions)- decodeFile "quux/strata/core/ccake.morph" `shouldReturn` (Just v9_mock_chunk_instructions_ccake :: Maybe ChunkInstructions)- decodeFile "quux/strata/core/sesame-sed.morph" `shouldReturn` (Just v9_mock_chunk_instructions_sesame_sed :: Maybe ChunkInstructions)+ "quux/strata/grilled-essential/brie-cc.morph" `testDecodeAgainst` v9_mock_chunk_instructions_brie_cc+ "quux/strata/grilled-essential/linux-api-headers.morph" `testDecodeAgainst` v9_mock_chunk_instructions_linux_api_headers+ "quux/strata/core/ccake.morph" `testDecodeAgainst` v9_mock_chunk_instructions_ccake+ "quux/strata/core/sesame-sed.morph" `testDecodeAgainst` v9_mock_chunk_instructions_sesame_sed it "encodes correctly" $ do BS.readFile "quux/strata/grilled-essential/brie-cc.morph" `shouldReturn` toPrettyYaml v9_mock_chunk_instructions_brie_cc BS.readFile "quux/strata/grilled-essential/linux-api-headers.morph" `shouldReturn` toPrettyYaml v9_mock_chunk_instructions_linux_api_headers@@ -147,15 +149,15 @@ describe "Stratum" $ do it "decodes correctly" $ do- decodeFile "quux/strata/grilled-essential.morph" `shouldReturn` (Just v9_mock_stratum_grilled_essential :: Maybe Stratum)- decodeFile "quux/strata/core.morph" `shouldReturn` (Just v9_mock_stratum_core :: Maybe Stratum)+ "quux/strata/grilled-essential.morph" `testDecodeAgainst` v9_mock_stratum_grilled_essential+ "quux/strata/core.morph" `testDecodeAgainst` v9_mock_stratum_core it "encodes correctly" $ do BS.readFile "quux/strata/grilled-essential.morph" `shouldReturn` toPrettyYaml v9_mock_stratum_grilled_essential BS.readFile "quux/strata/core.morph" `shouldReturn` toPrettyYaml v9_mock_stratum_core describe "System" $ do it "decodes correctly" $ do- decodeFile "quux/systems/quux-system-x86_32.morph" `shouldReturn` (Just v9_mock_system_quux :: Maybe System)+ "quux/systems/quux-system-x86_32.morph" `testDecodeAgainst` v9_mock_system_quux it "encodes correctly" $ do BS.readFile "quux/systems/quux-system-x86_32.morph" `shouldReturn` toPrettyYaml v9_mock_system_quux