Config.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module Haskus.Apps.System.Build.Config
   ( readSystemConfig
   , SystemConfig (..)
   , LinuxConfig (..)
   , linuxConfigHash
   , linuxConfigVersion
   , LinuxSource (..)
   , LinuxOptions (..)
   , SyslinuxConfig (..)
   , syslinuxConfigHash
   , RamdiskConfig (..)
   , QEMUConfig (..)
   )
where

import Data.Yaml as Yaml
import Data.Text (Text)
import Data.Hashable
import GHC.Generics

-- | System configuration
data SystemConfig = SystemConfig
   { linuxConfig    :: LinuxConfig     -- ^ Linux configuration
   , syslinuxConfig :: SyslinuxConfig  -- ^ Syslinux configuration
   , ramdiskConfig  :: RamdiskConfig   -- ^ Ramdisk configuration
   , qemuConfig     :: QEMUConfig      -- ^ QEMU configuration
   }
   deriving (Show)

instance FromJSON SystemConfig where
   parseJSON (Yaml.Object v) =
      SystemConfig
         <$> (v .: "linux")
         <*> (v .:? "syslinux" .!= defaultSyslinuxConfig)
         <*> (v .: "ramdisk")
         <*> (v .:? "qemu" .!= defaultQEMUConfig)

   parseJSON _ = fail "Invalid config file"

readSystemConfig :: FilePath -> IO (Either ParseException SystemConfig)
readSystemConfig = Yaml.decodeFileEither

-------------------------------------------------------------
-- Linux
-------------------------------------------------------------


-- | Linux source
data LinuxSource
   = LinuxTarball Text  -- ^ Linux x.y.z from kernel.org tarballs
   | LinuxGit Text Text -- ^ repository/commit hash
   deriving (Show,Generic,Hashable)

data LinuxOptions = LinuxOptions
   { enableOptions  :: [Text]
   , disableOptions :: [Text]
   , moduleOptions  :: [Text]
   }
   deriving (Show,Generic,Hashable)

-- | Linux configuration
data LinuxConfig = LinuxConfig
   { linuxSource   :: LinuxSource  -- ^ How to retrieve Linux
   , linuxOptions  :: LinuxOptions -- ^ Configuration options
   , linuxMakeArgs :: Text         -- ^ Make arguments
   }
   deriving (Show,Generic,Hashable)

-- | Hash Linux config
linuxConfigHash :: LinuxConfig -> Int
linuxConfigHash = hash

-- | Linux version
linuxConfigVersion :: LinuxConfig -> Text
linuxConfigVersion config = case linuxSource config of
   LinuxTarball t -> t
   LinuxGit {}    -> "git"

instance FromJSON LinuxConfig where
   parseJSON (Yaml.Object v) = do
      src     <- parseSource <$> (v .:? "source" .!= "tarball")
      options <- parseOptions <$> (v .:? "options")
      LinuxConfig
         <$> src
         <*> options
         <*> (v .:? "make-args" .!= "-j8")
      where
         parseSource :: Text -> Parser LinuxSource
         parseSource s = case s of
            "tarball" -> LinuxTarball <$> v .: "version"
            "git"     -> LinuxGit     <$> v .: "repository" <*> v .: "commit"
            r         -> fail $ "Invalid Linux source: " ++ show r

         parseOptions :: Maybe Yaml.Value -> Parser LinuxOptions
         parseOptions s = case s of
            Nothing                -> pure (LinuxOptions [] [] [])
            Just (Yaml.Object opt) ->
               LinuxOptions
                  <$> (opt .:? "enable"  .!= [])
                  <*> (opt .:? "disable" .!= [])
                  <*> (opt .:? "module"  .!= [])
            Just _ -> fail "Invalid Linux options"

            
   parseJSON _ = fail "Invalid Linux configuration"

-------------------------------------------------------------
-- Syslinux
-------------------------------------------------------------

-- | Syslinux configuration
data SyslinuxConfig = SyslinuxConfig
   { syslinuxVersion  :: Text     -- ^ Syslinux version
   }
   deriving (Show,Generic,Hashable)

-- | Hash Syslinux config
syslinuxConfigHash :: SyslinuxConfig -> Int
syslinuxConfigHash = hash

-- | Default Syslinux configuration
defaultSyslinuxConfig :: SyslinuxConfig
defaultSyslinuxConfig = SyslinuxConfig "6.03"

instance FromJSON SyslinuxConfig where
   parseJSON (Yaml.Object v) =
      SyslinuxConfig
         <$> (v .:? "version" .!= "6.03")

   parseJSON _ = fail "Invalid Syslinux configuration"


-------------------------------------------------------------
-- Ramdisk
-------------------------------------------------------------

-- | Ramdisk configuration
data RamdiskConfig = RamdiskConfig
   { ramdiskInit     :: Text   -- ^ Init program
   }
   deriving (Show)

instance FromJSON RamdiskConfig where
   parseJSON (Yaml.Object v) = do
      RamdiskConfig
         <$> v .: "init"

   parseJSON _ = fail "Invalid Ramdisk configuration"

-------------------------------------------------------------
-- QEMU
-------------------------------------------------------------

-- | QEMU configuration
data QEMUConfig = QEMUConfig
   { qemuProfile    :: Text -- ^ QEMU profile
   , qemuOptions    :: Text -- ^ QEMU additional options
   , qemuKernelArgs :: Text -- ^ kernel args (-append)
   }
   deriving (Show)

defaultQEMUConfig :: QEMUConfig
defaultQEMUConfig = QEMUConfig "default" "" ""

instance FromJSON QEMUConfig where
   parseJSON (Yaml.Object v) = do
      QEMUConfig
         <$> v .: "profile"      .!= "default"
         <*> v .:? "options"     .!= ""
         <*> v .:? "kernel-args" .!= ""

   parseJSON _ = fail "Invalid QEMU configuration"