V9.hs

{-# 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"]