{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module : Baserock.Schema.V9.Data -- Copyright : (c) Daniel Firth 2018 -- License : BSD3 -- Maintainer : locallycompact@gmail.com -- Stability : experimental -- -- This file defines the V9 Baserock Yaml Schema in Haskell -- ----------------------------------------------------------------------------- module Baserock.Schema.V9 ( module Data.Yaml.Pretty.Extras , -- * Schema 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 ) where import Data.Yaml.Pretty.Extras import Lens.Micro.Platform hiding ( (.=) ) import RIO import RIO.List import qualified RIO.Text as Text possibly f v = if v == mzero then mzero else [f .= v] -- * 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] } deriving (Eq, Show) $(makeLenses ''ChunkInstructions) instance FromJSON ChunkInstructions where parseJSON (Object v) = ChunkInstructions <$> v .: "name" <*> v .:? "build-system" .!= "manual" <*> v .:? "pre-configure-commands" .!= [] <*> v .:? "configure-commands" .!= [] <*> v .:? "post-configure-commands" .!= [] <*> v .:? "pre-build-commands" .!= [] <*> v .:? "build-commands" .!= [] <*> v .:? "post-build-commands" .!= [] <*> v .:? "pre-install-commands" .!= [] <*> v .:? "install-commands" .!= [] <*> v .:? "post-install-commands" .!= [] 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) instance ToPrettyYaml ChunkInstructions where fieldOrder = const $ ["name", "kind", "build-system"] <> fmap (<> "-commands") ["configure", "build", "install"] >>= \x -> ["pre-" <> x, x, "post-" <> x] <> ["rpm-metadata"] -- Stratum ("stratum.morph") data Chunk = Chunk { _chunkName :: Text, _chunkMorph :: Maybe Text, _repo :: Maybe Text, _ref :: Maybe Text, _sha :: Maybe Text, _buildMode :: Text, _chunkBuildSystem :: Text, _chunkBDs :: [Text] } deriving (Eq, Show) $(makeLenses ''Chunk) instance FromJSON Chunk where parseJSON (Object v) = Chunk <$> v .: "name" <*> v .:? "morph" <*> v .:? "repo" <*> v .:? "ref" <*> v .:? "sha" <*> v .:? "build-mode" .!= "staging" <*> v .:? "build-system" .!= "manual" <*> 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) <> (if _buildMode x == "staging" then mempty else ["build-mode" .= _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"] newtype StratumBD = StratumBD { _stratumBDMorph :: Text } deriving (Eq, Show) $(makeLenses ''StratumBD) instance FromJSON StratumBD where parseJSON (Object v) = StratumBD <$> v .: "morph" instance ToJSON StratumBD where 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] } deriving (Eq, Show) $(makeLenses ''Stratum) instance FromJSON Stratum where 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) instance ToPrettyYaml Stratum where 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 } deriving (Eq, Show) $(makeLenses ''StratumInclude) instance FromJSON StratumInclude where parseJSON (Object v) = StratumInclude <$> v .: "name" <*> v .: "morph" instance ToJSON StratumInclude where 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] } deriving (Eq, Show) $(makeLenses ''System) instance FromJSON System where parseJSON (Object v) = System <$> v .: "name" <*> v .:? "description" <*> v .: "arch" <*> v .: "strata" <*> 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) instance ToPrettyYaml System where fieldOrder = const ["name", "morph", "kind", "description", "arch", "strata", "configuration-extensions"]