From 0af33cecec5d0a9a23fb4b1758455cef3840db88 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 10 Jul 2018 06:29:05 -0400 Subject: separate module ConfigFile --- fsmgr.cabal | 13 +++++----- fsmgr.hs | 63 ++------------------------------------------- src/ConfigFile.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 68 deletions(-) create mode 100644 src/ConfigFile.hs diff --git a/fsmgr.cabal b/fsmgr.cabal index 95ec00c..3da9bf6 100644 --- a/fsmgr.cabal +++ b/fsmgr.cabal @@ -19,14 +19,13 @@ source-repository head library exposed-modules: - Crypto.Hash.Types.Digest.Read + Crypto.Hash.Types.Digest.Read, ConfigFile other-modules: Paths_fsmgr hs-source-dirs: src - build-depends: - base >=4.7 && <5, rebase, optparse-applicative, typed-process, - directory, filepath, yaml, lens, lens-aeson, cryptonite, memory, basement + build-depends: base >=4.7 && <5, rebase, optparse-applicative, typed-process, + directory, filepath, yaml-combinators, lens, lens-aeson, cryptonite, memory, basement, shake default-language: Haskell2010 executable fsmgr @@ -34,9 +33,9 @@ executable fsmgr other-modules: Paths_fsmgr ghc-options: -threaded -rtsopts -with-rtsopts=-N -W -Wall - build-depends: - base >=4.7 && <5, rebase, optparse-applicative, typed-process, - directory, filepath, yaml-combinators, lens, lens-aeson, cryptonite, memory, basement, fsmgr, shake + build-depends: fsmgr, + base >=4.7 && <5, rebase, optparse-applicative, typed-process, + directory, filepath, yaml-combinators, lens, lens-aeson, cryptonite, memory, basement, shake default-language: Haskell2010 -- test-suite fsmgr-test diff --git a/fsmgr.hs b/fsmgr.hs index 626f79f..d5df8ac 100644 --- a/fsmgr.hs +++ b/fsmgr.hs @@ -10,72 +10,13 @@ module Main where import Rebase.Prelude hiding (bool, hash, (<.>)) -import Data.Yaml.Combinators import Development.Shake hiding (getEnv) import Development.Shake.Command () import Development.Shake.FilePath -import qualified Rebase.Data.Set as Set import qualified Rebase.Data.Text as Text ;import Rebase.Data.Text (pack, unpack) -import Rebase.Data.Text.Encoding -import qualified Rebase.Data.Vector as Vector -{- - -Basic idea is to have a fs.yaml that specifies the build procedure. Analogous to -stack.yaml, it should specify everything (every source) directly or indirectly. - -We want to make new images from CoW copies of old ones. We want to build these -things incrementally, but still end up with something that will be reproducible -from scratch. - -Anyway, what we'll have is a list of packages, which will be unpacked first. -Then a list of debconf values, which will be applied. Then we will have the rest -of the other, slower changes to the image (including dpkg --configure -a). Some -changes can be assumed to produce the same results out of order. Oh right, and -the zeroeth step is to generate the empty (or just initial) filesystem image. -The initial filesystem image, if nonempty, is specified by filename (otherwise, -by size), while the hash of the configuration determines the output filename. - --- - -'Parent' param should be a config file, not hash. The hash will only be used to -determine whether we need to build it. - --} - -newtype DebconfConfig = DebconfConfig Text deriving (Show, Read, Eq, Ord) -newtype Package = Package Text deriving (Show, Read, Eq, Ord) -data Patch = Patch deriving (Show, Read) - -data BaseImageSpecification - = EmptyImageOfBytes Int - | ParentImageConfigFile FilePath - deriving (Show, Read) - -data DiskImageConfig = DiskImageConfig { - initialImage :: BaseImageSpecification -, packages :: Set Package -, debconfConfig :: Maybe FilePath -, unpackOnly :: Bool -, binaries :: Vector Text -, chrootCommands :: Vector Text -} deriving (Show, Read) - -parsePackageName :: Text -> Package -parsePackageName = Package -- TODO - -diskImageConfigParser :: Parser DiskImageConfig -diskImageConfigParser = object $ - DiskImageConfig - <$> field "parent" ((EmptyImageOfBytes <$> integer) <> (ParentImageConfigFile . unpack <$> string)) - <*> (Set.fromList . toList . fmap parsePackageName <$> defaultField "packages" Vector.empty (array string)) - <*> (fmap unpack <$> optField "debconf" string) - <*> defaultField "unpack-only" False bool - <*> defaultField "binaries" Vector.empty (array string) - <*> defaultField "chroot-commands" Vector.empty (array string) - -readCfg :: FilePath -> Action DiskImageConfig -readCfg yaml = either error id . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml + +import ConfigFile noParent :: BaseImageSpecification -> Bool noParent (EmptyImageOfBytes _) = True diff --git a/src/ConfigFile.hs b/src/ConfigFile.hs new file mode 100644 index 0000000..8b23582 --- /dev/null +++ b/src/ConfigFile.hs @@ -0,0 +1,77 @@ +{-# OPTIONS_GHC -fno-warn-type-defaults #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module ConfigFile where +import Rebase.Prelude hiding (bool, hash, (<.>)) + +import Data.Yaml.Combinators +import Development.Shake hiding (getEnv) +import Development.Shake.Command () +import qualified Rebase.Data.Set as Set +import Rebase.Data.Text (pack, unpack) +import Rebase.Data.Text.Encoding +import qualified Rebase.Data.Vector as Vector +{- + +Basic idea is to have a fs.yaml that specifies the build procedure. Analogous to +stack.yaml, it should specify everything (every source) directly or indirectly. + +We want to make new images from CoW copies of old ones. We want to build these +things incrementally, but still end up with something that will be reproducible +from scratch. + +Anyway, what we'll have is a list of packages, which will be unpacked first. +Then a list of debconf values, which will be applied. Then we will have the rest +of the other, slower changes to the image (including dpkg --configure -a). Some +changes can be assumed to produce the same results out of order. Oh right, and +the zeroeth step is to generate the empty (or just initial) filesystem image. +The initial filesystem image, if nonempty, is specified by filename (otherwise, +by size), while the hash of the configuration determines the output filename. + +-- + +'Parent' param should be a config file, not hash. The hash will only be used to +determine whether we need to build it. + +-} + +newtype DebconfConfig = DebconfConfig Text deriving (Show, Read, Eq, Ord) +newtype Package = Package Text deriving (Show, Read, Eq, Ord) +data Patch = Patch deriving (Show, Read) + +data BaseImageSpecification + = EmptyImageOfBytes Int + | ParentImageConfigFile FilePath + deriving (Show, Read) + +data DiskImageConfig = DiskImageConfig { + initialImage :: BaseImageSpecification +, packages :: Set Package +, debconfConfig :: Maybe FilePath +, unpackOnly :: Bool +, binaries :: Vector Text +, chrootCommands :: Vector Text +} deriving (Show, Read) + +parsePackageName :: Text -> Package +parsePackageName = Package -- TODO + +diskImageConfigParser :: Parser DiskImageConfig +diskImageConfigParser = object $ + DiskImageConfig + <$> field "parent" ((EmptyImageOfBytes <$> integer) <> (ParentImageConfigFile . unpack <$> string)) + <*> (Set.fromList . toList . fmap parsePackageName <$> defaultField "packages" Vector.empty (array string)) + <*> (fmap unpack <$> optField "debconf" string) + <*> defaultField "unpack-only" False bool + <*> defaultField "binaries" Vector.empty (array string) + <*> defaultField "chroot-commands" Vector.empty (array string) + +readCfg :: FilePath -> Action DiskImageConfig +readCfg yaml = either error id . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml + -- cgit v1.2.3