-- | Data types that describe all B9 relevant elements of virtual machine disk
-- images.
module B9.DiskImages where

import B9.QCUtil
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Hashable
import Data.Map (Map)
import Data.Maybe
import Data.Semigroup as Sem
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Calendar (Day (ModifiedJulianDay))
import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, secondsToDiffTime)
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeOrError)
import GHC.Generics (Generic)
import System.FilePath
import Test.Hspec (Spec, describe, it)
import Test.QuickCheck
import qualified Text.PrettyPrint.Boxes as Boxes
import Text.Printf

-- * Data types for disk image description, e.g. 'ImageTarget',
-- 'ImageDestination', 'Image', 'MountPoint', 'SharedImage'

-- | Build target for disk images; the destination, format and size of the image
-- to generate, as well as how to create or obtain the image before a
-- 'B9.Vm.VmScript' is executed with the image mounted at a 'MountPoint'.
data ImageTarget
  = ImageTarget
      ImageDestination
      ImageSource
      MountPoint
  deriving (ReadPrec [ImageTarget]
ReadPrec ImageTarget
Int -> ReadS ImageTarget
ReadS [ImageTarget]
(Int -> ReadS ImageTarget)
-> ReadS [ImageTarget]
-> ReadPrec ImageTarget
-> ReadPrec [ImageTarget]
-> Read ImageTarget
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageTarget]
$creadListPrec :: ReadPrec [ImageTarget]
readPrec :: ReadPrec ImageTarget
$creadPrec :: ReadPrec ImageTarget
readList :: ReadS [ImageTarget]
$creadList :: ReadS [ImageTarget]
readsPrec :: Int -> ReadS ImageTarget
$creadsPrec :: Int -> ReadS ImageTarget
Read, Int -> ImageTarget -> ShowS
[ImageTarget] -> ShowS
ImageTarget -> String
(Int -> ImageTarget -> ShowS)
-> (ImageTarget -> String)
-> ([ImageTarget] -> ShowS)
-> Show ImageTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageTarget] -> ShowS
$cshowList :: [ImageTarget] -> ShowS
show :: ImageTarget -> String
$cshow :: ImageTarget -> String
showsPrec :: Int -> ImageTarget -> ShowS
$cshowsPrec :: Int -> ImageTarget -> ShowS
Show, Typeable, Typeable ImageTarget
DataType
Constr
Typeable ImageTarget
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageTarget -> c ImageTarget)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageTarget)
-> (ImageTarget -> Constr)
-> (ImageTarget -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageTarget))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImageTarget))
-> ((forall b. Data b => b -> b) -> ImageTarget -> ImageTarget)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageTarget -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageTarget -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImageTarget -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageTarget -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget)
-> Data ImageTarget
ImageTarget -> DataType
ImageTarget -> Constr
(forall b. Data b => b -> b) -> ImageTarget -> ImageTarget
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageTarget -> c ImageTarget
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImageTarget -> u
forall u. (forall d. Data d => d -> u) -> ImageTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageTarget -> c ImageTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageTarget)
$cImageTarget :: Constr
$tImageTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
gmapMp :: (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
gmapM :: (forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageTarget -> m ImageTarget
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageTarget -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImageTarget -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageTarget -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageTarget -> r
gmapT :: (forall b. Data b => b -> b) -> ImageTarget -> ImageTarget
$cgmapT :: (forall b. Data b => b -> b) -> ImageTarget -> ImageTarget
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageTarget)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageTarget)
dataTypeOf :: ImageTarget -> DataType
$cdataTypeOf :: ImageTarget -> DataType
toConstr :: ImageTarget -> Constr
$ctoConstr :: ImageTarget -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageTarget
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageTarget -> c ImageTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageTarget -> c ImageTarget
$cp1Data :: Typeable ImageTarget
Data, ImageTarget -> ImageTarget -> Bool
(ImageTarget -> ImageTarget -> Bool)
-> (ImageTarget -> ImageTarget -> Bool) -> Eq ImageTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageTarget -> ImageTarget -> Bool
$c/= :: ImageTarget -> ImageTarget -> Bool
== :: ImageTarget -> ImageTarget -> Bool
$c== :: ImageTarget -> ImageTarget -> Bool
Eq, (forall x. ImageTarget -> Rep ImageTarget x)
-> (forall x. Rep ImageTarget x -> ImageTarget)
-> Generic ImageTarget
forall x. Rep ImageTarget x -> ImageTarget
forall x. ImageTarget -> Rep ImageTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageTarget x -> ImageTarget
$cfrom :: forall x. ImageTarget -> Rep ImageTarget x
Generic)

instance Hashable ImageTarget

instance Binary ImageTarget

instance NFData ImageTarget

-- | A mount point or 'NotMounted'
data MountPoint = MountPoint FilePath | NotMounted
  deriving (Int -> MountPoint -> ShowS
[MountPoint] -> ShowS
MountPoint -> String
(Int -> MountPoint -> ShowS)
-> (MountPoint -> String)
-> ([MountPoint] -> ShowS)
-> Show MountPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MountPoint] -> ShowS
$cshowList :: [MountPoint] -> ShowS
show :: MountPoint -> String
$cshow :: MountPoint -> String
showsPrec :: Int -> MountPoint -> ShowS
$cshowsPrec :: Int -> MountPoint -> ShowS
Show, ReadPrec [MountPoint]
ReadPrec MountPoint
Int -> ReadS MountPoint
ReadS [MountPoint]
(Int -> ReadS MountPoint)
-> ReadS [MountPoint]
-> ReadPrec MountPoint
-> ReadPrec [MountPoint]
-> Read MountPoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MountPoint]
$creadListPrec :: ReadPrec [MountPoint]
readPrec :: ReadPrec MountPoint
$creadPrec :: ReadPrec MountPoint
readList :: ReadS [MountPoint]
$creadList :: ReadS [MountPoint]
readsPrec :: Int -> ReadS MountPoint
$creadsPrec :: Int -> ReadS MountPoint
Read, Typeable, Typeable MountPoint
DataType
Constr
Typeable MountPoint
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MountPoint -> c MountPoint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MountPoint)
-> (MountPoint -> Constr)
-> (MountPoint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MountPoint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MountPoint))
-> ((forall b. Data b => b -> b) -> MountPoint -> MountPoint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MountPoint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MountPoint -> r)
-> (forall u. (forall d. Data d => d -> u) -> MountPoint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MountPoint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint)
-> Data MountPoint
MountPoint -> DataType
MountPoint -> Constr
(forall b. Data b => b -> b) -> MountPoint -> MountPoint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MountPoint -> c MountPoint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MountPoint
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MountPoint -> u
forall u. (forall d. Data d => d -> u) -> MountPoint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MountPoint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MountPoint -> c MountPoint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MountPoint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MountPoint)
$cNotMounted :: Constr
$cMountPoint :: Constr
$tMountPoint :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
gmapMp :: (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
gmapM :: (forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MountPoint -> m MountPoint
gmapQi :: Int -> (forall d. Data d => d -> u) -> MountPoint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MountPoint -> u
gmapQ :: (forall d. Data d => d -> u) -> MountPoint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MountPoint -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MountPoint -> r
gmapT :: (forall b. Data b => b -> b) -> MountPoint -> MountPoint
$cgmapT :: (forall b. Data b => b -> b) -> MountPoint -> MountPoint
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MountPoint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MountPoint)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MountPoint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MountPoint)
dataTypeOf :: MountPoint -> DataType
$cdataTypeOf :: MountPoint -> DataType
toConstr :: MountPoint -> Constr
$ctoConstr :: MountPoint -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MountPoint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MountPoint
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MountPoint -> c MountPoint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MountPoint -> c MountPoint
$cp1Data :: Typeable MountPoint
Data, MountPoint -> MountPoint -> Bool
(MountPoint -> MountPoint -> Bool)
-> (MountPoint -> MountPoint -> Bool) -> Eq MountPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MountPoint -> MountPoint -> Bool
$c/= :: MountPoint -> MountPoint -> Bool
== :: MountPoint -> MountPoint -> Bool
$c== :: MountPoint -> MountPoint -> Bool
Eq, (forall x. MountPoint -> Rep MountPoint x)
-> (forall x. Rep MountPoint x -> MountPoint) -> Generic MountPoint
forall x. Rep MountPoint x -> MountPoint
forall x. MountPoint -> Rep MountPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MountPoint x -> MountPoint
$cfrom :: forall x. MountPoint -> Rep MountPoint x
Generic)

instance Hashable MountPoint

instance Binary MountPoint

instance NFData MountPoint

-- | The destination of an image.
data ImageDestination
  = -- | Create the image and some meta data so that other
    -- builds can use them as 'ImageSource's via 'From'.
    Share String ImageType ImageResize
  | -- | __DEPRECATED__ Export a raw image that can directly
    -- be booted.
    LiveInstallerImage String FilePath ImageResize
  | -- | Write an image file to the path in the first
    -- argument., possible resizing it,
    LocalFile Image ImageResize
  | -- | Do not export the image. Usefule if the main
    -- objective of the b9 build is not an image file, but
    -- rather some artifact produced by executing by a
    -- containerize build.
    Transient
  deriving (ReadPrec [ImageDestination]
ReadPrec ImageDestination
Int -> ReadS ImageDestination
ReadS [ImageDestination]
(Int -> ReadS ImageDestination)
-> ReadS [ImageDestination]
-> ReadPrec ImageDestination
-> ReadPrec [ImageDestination]
-> Read ImageDestination
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageDestination]
$creadListPrec :: ReadPrec [ImageDestination]
readPrec :: ReadPrec ImageDestination
$creadPrec :: ReadPrec ImageDestination
readList :: ReadS [ImageDestination]
$creadList :: ReadS [ImageDestination]
readsPrec :: Int -> ReadS ImageDestination
$creadsPrec :: Int -> ReadS ImageDestination
Read, Int -> ImageDestination -> ShowS
[ImageDestination] -> ShowS
ImageDestination -> String
(Int -> ImageDestination -> ShowS)
-> (ImageDestination -> String)
-> ([ImageDestination] -> ShowS)
-> Show ImageDestination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageDestination] -> ShowS
$cshowList :: [ImageDestination] -> ShowS
show :: ImageDestination -> String
$cshow :: ImageDestination -> String
showsPrec :: Int -> ImageDestination -> ShowS
$cshowsPrec :: Int -> ImageDestination -> ShowS
Show, Typeable, Typeable ImageDestination
DataType
Constr
Typeable ImageDestination
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageDestination -> c ImageDestination)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageDestination)
-> (ImageDestination -> Constr)
-> (ImageDestination -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageDestination))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImageDestination))
-> ((forall b. Data b => b -> b)
    -> ImageDestination -> ImageDestination)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageDestination -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageDestination -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ImageDestination -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageDestination -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ImageDestination -> m ImageDestination)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImageDestination -> m ImageDestination)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImageDestination -> m ImageDestination)
-> Data ImageDestination
ImageDestination -> DataType
ImageDestination -> Constr
(forall b. Data b => b -> b)
-> ImageDestination -> ImageDestination
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageDestination -> c ImageDestination
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageDestination
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ImageDestination -> u
forall u. (forall d. Data d => d -> u) -> ImageDestination -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageDestination
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageDestination -> c ImageDestination
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageDestination)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageDestination)
$cTransient :: Constr
$cLocalFile :: Constr
$cLiveInstallerImage :: Constr
$cShare :: Constr
$tImageDestination :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
gmapMp :: (forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
gmapM :: (forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImageDestination -> m ImageDestination
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageDestination -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ImageDestination -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageDestination -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageDestination -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageDestination -> r
gmapT :: (forall b. Data b => b -> b)
-> ImageDestination -> ImageDestination
$cgmapT :: (forall b. Data b => b -> b)
-> ImageDestination -> ImageDestination
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageDestination)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageDestination)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageDestination)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageDestination)
dataTypeOf :: ImageDestination -> DataType
$cdataTypeOf :: ImageDestination -> DataType
toConstr :: ImageDestination -> Constr
$ctoConstr :: ImageDestination -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageDestination
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageDestination
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageDestination -> c ImageDestination
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageDestination -> c ImageDestination
$cp1Data :: Typeable ImageDestination
Data, ImageDestination -> ImageDestination -> Bool
(ImageDestination -> ImageDestination -> Bool)
-> (ImageDestination -> ImageDestination -> Bool)
-> Eq ImageDestination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageDestination -> ImageDestination -> Bool
$c/= :: ImageDestination -> ImageDestination -> Bool
== :: ImageDestination -> ImageDestination -> Bool
$c== :: ImageDestination -> ImageDestination -> Bool
Eq, (forall x. ImageDestination -> Rep ImageDestination x)
-> (forall x. Rep ImageDestination x -> ImageDestination)
-> Generic ImageDestination
forall x. Rep ImageDestination x -> ImageDestination
forall x. ImageDestination -> Rep ImageDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageDestination x -> ImageDestination
$cfrom :: forall x. ImageDestination -> Rep ImageDestination x
Generic)

instance Hashable ImageDestination

instance Binary ImageDestination

instance NFData ImageDestination

-- | Specification of how the image to build is obtained.
data ImageSource
  = -- | Create an empty image file having a file system label
    -- (first parameter), a file system type (e.g. 'Ext4') and an
    -- 'ImageSize'
    EmptyImage String FileSystem ImageType ImageSize
  | -- | __DEPRECATED__
    CopyOnWrite Image
  | -- | Clone an existing image file; if the image file contains
    -- partitions, select the partition to use, b9 will extract
    -- that partition by reading the offset of the partition from
    -- the partition table and extract it using @dd@.
    SourceImage Image Partition ImageResize
  | -- | Use an image previously shared by via 'Share'.
    From String ImageResize
  deriving (Int -> ImageSource -> ShowS
[ImageSource] -> ShowS
ImageSource -> String
(Int -> ImageSource -> ShowS)
-> (ImageSource -> String)
-> ([ImageSource] -> ShowS)
-> Show ImageSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageSource] -> ShowS
$cshowList :: [ImageSource] -> ShowS
show :: ImageSource -> String
$cshow :: ImageSource -> String
showsPrec :: Int -> ImageSource -> ShowS
$cshowsPrec :: Int -> ImageSource -> ShowS
Show, ReadPrec [ImageSource]
ReadPrec ImageSource
Int -> ReadS ImageSource
ReadS [ImageSource]
(Int -> ReadS ImageSource)
-> ReadS [ImageSource]
-> ReadPrec ImageSource
-> ReadPrec [ImageSource]
-> Read ImageSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageSource]
$creadListPrec :: ReadPrec [ImageSource]
readPrec :: ReadPrec ImageSource
$creadPrec :: ReadPrec ImageSource
readList :: ReadS [ImageSource]
$creadList :: ReadS [ImageSource]
readsPrec :: Int -> ReadS ImageSource
$creadsPrec :: Int -> ReadS ImageSource
Read, Typeable, Typeable ImageSource
DataType
Constr
Typeable ImageSource
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageSource -> c ImageSource)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageSource)
-> (ImageSource -> Constr)
-> (ImageSource -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageSource))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImageSource))
-> ((forall b. Data b => b -> b) -> ImageSource -> ImageSource)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageSource -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageSource -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImageSource -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageSource -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource)
-> Data ImageSource
ImageSource -> DataType
ImageSource -> Constr
(forall b. Data b => b -> b) -> ImageSource -> ImageSource
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSource -> c ImageSource
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSource
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImageSource -> u
forall u. (forall d. Data d => d -> u) -> ImageSource -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSource
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSource -> c ImageSource
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageSource)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageSource)
$cFrom :: Constr
$cSourceImage :: Constr
$cCopyOnWrite :: Constr
$cEmptyImage :: Constr
$tImageSource :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
gmapMp :: (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
gmapM :: (forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageSource -> m ImageSource
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageSource -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImageSource -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageSource -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageSource -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSource -> r
gmapT :: (forall b. Data b => b -> b) -> ImageSource -> ImageSource
$cgmapT :: (forall b. Data b => b -> b) -> ImageSource -> ImageSource
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageSource)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageSource)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageSource)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageSource)
dataTypeOf :: ImageSource -> DataType
$cdataTypeOf :: ImageSource -> DataType
toConstr :: ImageSource -> Constr
$ctoConstr :: ImageSource -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSource
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSource
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSource -> c ImageSource
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSource -> c ImageSource
$cp1Data :: Typeable ImageSource
Data, ImageSource -> ImageSource -> Bool
(ImageSource -> ImageSource -> Bool)
-> (ImageSource -> ImageSource -> Bool) -> Eq ImageSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageSource -> ImageSource -> Bool
$c/= :: ImageSource -> ImageSource -> Bool
== :: ImageSource -> ImageSource -> Bool
$c== :: ImageSource -> ImageSource -> Bool
Eq, (forall x. ImageSource -> Rep ImageSource x)
-> (forall x. Rep ImageSource x -> ImageSource)
-> Generic ImageSource
forall x. Rep ImageSource x -> ImageSource
forall x. ImageSource -> Rep ImageSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageSource x -> ImageSource
$cfrom :: forall x. ImageSource -> Rep ImageSource x
Generic)

instance Hashable ImageSource

instance Binary ImageSource

instance NFData ImageSource

-- | The partition to extract.
data Partition
  = -- | There is no partition table on the image
    NoPT
  | -- | Extract partition @n@ @n@ must be in @0..3@
    Partition Int
  deriving (Partition -> Partition -> Bool
(Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool) -> Eq Partition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Partition -> Partition -> Bool
$c/= :: Partition -> Partition -> Bool
== :: Partition -> Partition -> Bool
$c== :: Partition -> Partition -> Bool
Eq, Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partition] -> ShowS
$cshowList :: [Partition] -> ShowS
show :: Partition -> String
$cshow :: Partition -> String
showsPrec :: Int -> Partition -> ShowS
$cshowsPrec :: Int -> Partition -> ShowS
Show, ReadPrec [Partition]
ReadPrec Partition
Int -> ReadS Partition
ReadS [Partition]
(Int -> ReadS Partition)
-> ReadS [Partition]
-> ReadPrec Partition
-> ReadPrec [Partition]
-> Read Partition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Partition]
$creadListPrec :: ReadPrec [Partition]
readPrec :: ReadPrec Partition
$creadPrec :: ReadPrec Partition
readList :: ReadS [Partition]
$creadList :: ReadS [Partition]
readsPrec :: Int -> ReadS Partition
$creadsPrec :: Int -> ReadS Partition
Read, Typeable, Typeable Partition
DataType
Constr
Typeable Partition
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Partition -> c Partition)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Partition)
-> (Partition -> Constr)
-> (Partition -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Partition))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Partition))
-> ((forall b. Data b => b -> b) -> Partition -> Partition)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Partition -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Partition -> r)
-> (forall u. (forall d. Data d => d -> u) -> Partition -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Partition -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Partition -> m Partition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Partition -> m Partition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Partition -> m Partition)
-> Data Partition
Partition -> DataType
Partition -> Constr
(forall b. Data b => b -> b) -> Partition -> Partition
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Partition -> c Partition
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Partition
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Partition -> u
forall u. (forall d. Data d => d -> u) -> Partition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Partition -> m Partition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Partition -> m Partition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Partition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Partition -> c Partition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Partition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Partition)
$cPartition :: Constr
$cNoPT :: Constr
$tPartition :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Partition -> m Partition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Partition -> m Partition
gmapMp :: (forall d. Data d => d -> m d) -> Partition -> m Partition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Partition -> m Partition
gmapM :: (forall d. Data d => d -> m d) -> Partition -> m Partition
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Partition -> m Partition
gmapQi :: Int -> (forall d. Data d => d -> u) -> Partition -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Partition -> u
gmapQ :: (forall d. Data d => d -> u) -> Partition -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Partition -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Partition -> r
gmapT :: (forall b. Data b => b -> b) -> Partition -> Partition
$cgmapT :: (forall b. Data b => b -> b) -> Partition -> Partition
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Partition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Partition)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Partition)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Partition)
dataTypeOf :: Partition -> DataType
$cdataTypeOf :: Partition -> DataType
toConstr :: Partition -> Constr
$ctoConstr :: Partition -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Partition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Partition
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Partition -> c Partition
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Partition -> c Partition
$cp1Data :: Typeable Partition
Data, (forall x. Partition -> Rep Partition x)
-> (forall x. Rep Partition x -> Partition) -> Generic Partition
forall x. Rep Partition x -> Partition
forall x. Partition -> Rep Partition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Partition x -> Partition
$cfrom :: forall x. Partition -> Rep Partition x
Generic)

instance Hashable Partition

instance Binary Partition

instance NFData Partition

-- | A vm disk image file consisting of a path to the image file, and the type
-- and file system.
data Image = Image FilePath ImageType FileSystem
  deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, ReadPrec [Image]
ReadPrec Image
Int -> ReadS Image
ReadS [Image]
(Int -> ReadS Image)
-> ReadS [Image]
-> ReadPrec Image
-> ReadPrec [Image]
-> Read Image
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Read, Typeable, Typeable Image
DataType
Constr
Typeable Image
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Image -> c Image)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Image)
-> (Image -> Constr)
-> (Image -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Image))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image))
-> ((forall b. Data b => b -> b) -> Image -> Image)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r)
-> (forall u. (forall d. Data d => d -> u) -> Image -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Image -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Image -> m Image)
-> Data Image
Image -> DataType
Image -> Constr
(forall b. Data b => b -> b) -> Image -> Image
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Image -> u
forall u. (forall d. Data d => d -> u) -> Image -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Image -> m Image
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Image)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
$cImage :: Constr
$tImage :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Image -> m Image
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapMp :: (forall d. Data d => d -> m d) -> Image -> m Image
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapM :: (forall d. Data d => d -> m d) -> Image -> m Image
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Image -> m Image
gmapQi :: Int -> (forall d. Data d => d -> u) -> Image -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Image -> u
gmapQ :: (forall d. Data d => d -> u) -> Image -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Image -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Image -> r
gmapT :: (forall b. Data b => b -> b) -> Image -> Image
$cgmapT :: (forall b. Data b => b -> b) -> Image -> Image
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Image)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Image)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Image)
dataTypeOf :: Image -> DataType
$cdataTypeOf :: Image -> DataType
toConstr :: Image -> Constr
$ctoConstr :: Image -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Image
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Image -> c Image
$cp1Data :: Typeable Image
Data, (forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic)

instance Hashable Image

instance Binary Image

instance NFData Image

-- | An image type defines the actual /file format/ of a file containing file
-- systems. These are like /virtual harddrives/
data ImageType = Raw | QCow2 | Vmdk
  deriving (ImageType -> ImageType -> Bool
(ImageType -> ImageType -> Bool)
-> (ImageType -> ImageType -> Bool) -> Eq ImageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageType -> ImageType -> Bool
$c/= :: ImageType -> ImageType -> Bool
== :: ImageType -> ImageType -> Bool
$c== :: ImageType -> ImageType -> Bool
Eq, ReadPrec [ImageType]
ReadPrec ImageType
Int -> ReadS ImageType
ReadS [ImageType]
(Int -> ReadS ImageType)
-> ReadS [ImageType]
-> ReadPrec ImageType
-> ReadPrec [ImageType]
-> Read ImageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageType]
$creadListPrec :: ReadPrec [ImageType]
readPrec :: ReadPrec ImageType
$creadPrec :: ReadPrec ImageType
readList :: ReadS [ImageType]
$creadList :: ReadS [ImageType]
readsPrec :: Int -> ReadS ImageType
$creadsPrec :: Int -> ReadS ImageType
Read, Typeable, Typeable ImageType
DataType
Constr
Typeable ImageType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageType -> c ImageType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageType)
-> (ImageType -> Constr)
-> (ImageType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageType))
-> ((forall b. Data b => b -> b) -> ImageType -> ImageType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImageType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImageType -> m ImageType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageType -> m ImageType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageType -> m ImageType)
-> Data ImageType
ImageType -> DataType
ImageType -> Constr
(forall b. Data b => b -> b) -> ImageType -> ImageType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageType -> c ImageType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImageType -> u
forall u. (forall d. Data d => d -> u) -> ImageType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageType -> m ImageType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageType -> m ImageType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageType -> c ImageType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageType)
$cVmdk :: Constr
$cQCow2 :: Constr
$cRaw :: Constr
$tImageType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ImageType -> m ImageType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageType -> m ImageType
gmapMp :: (forall d. Data d => d -> m d) -> ImageType -> m ImageType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageType -> m ImageType
gmapM :: (forall d. Data d => d -> m d) -> ImageType -> m ImageType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageType -> m ImageType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImageType -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageType -> r
gmapT :: (forall b. Data b => b -> b) -> ImageType -> ImageType
$cgmapT :: (forall b. Data b => b -> b) -> ImageType -> ImageType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageType)
dataTypeOf :: ImageType -> DataType
$cdataTypeOf :: ImageType -> DataType
toConstr :: ImageType -> Constr
$ctoConstr :: ImageType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageType -> c ImageType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageType -> c ImageType
$cp1Data :: Typeable ImageType
Data, Int -> ImageType -> ShowS
[ImageType] -> ShowS
ImageType -> String
(Int -> ImageType -> ShowS)
-> (ImageType -> String)
-> ([ImageType] -> ShowS)
-> Show ImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageType] -> ShowS
$cshowList :: [ImageType] -> ShowS
show :: ImageType -> String
$cshow :: ImageType -> String
showsPrec :: Int -> ImageType -> ShowS
$cshowsPrec :: Int -> ImageType -> ShowS
Show, (forall x. ImageType -> Rep ImageType x)
-> (forall x. Rep ImageType x -> ImageType) -> Generic ImageType
forall x. Rep ImageType x -> ImageType
forall x. ImageType -> Rep ImageType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageType x -> ImageType
$cfrom :: forall x. ImageType -> Rep ImageType x
Generic)

instance CoArbitrary ImageType

instance Function ImageType

instance Hashable ImageType

instance Binary ImageType

instance NFData ImageType

-- | The file systems that b9 can use and convert.
data FileSystem = NoFileSystem | Ext4 | Ext4_64 | ISO9660 | VFAT
  deriving (FileSystem -> FileSystem -> Bool
(FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> Bool) -> Eq FileSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSystem -> FileSystem -> Bool
$c/= :: FileSystem -> FileSystem -> Bool
== :: FileSystem -> FileSystem -> Bool
$c== :: FileSystem -> FileSystem -> Bool
Eq, Int -> FileSystem -> ShowS
[FileSystem] -> ShowS
FileSystem -> String
(Int -> FileSystem -> ShowS)
-> (FileSystem -> String)
-> ([FileSystem] -> ShowS)
-> Show FileSystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSystem] -> ShowS
$cshowList :: [FileSystem] -> ShowS
show :: FileSystem -> String
$cshow :: FileSystem -> String
showsPrec :: Int -> FileSystem -> ShowS
$cshowsPrec :: Int -> FileSystem -> ShowS
Show, ReadPrec [FileSystem]
ReadPrec FileSystem
Int -> ReadS FileSystem
ReadS [FileSystem]
(Int -> ReadS FileSystem)
-> ReadS [FileSystem]
-> ReadPrec FileSystem
-> ReadPrec [FileSystem]
-> Read FileSystem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileSystem]
$creadListPrec :: ReadPrec [FileSystem]
readPrec :: ReadPrec FileSystem
$creadPrec :: ReadPrec FileSystem
readList :: ReadS [FileSystem]
$creadList :: ReadS [FileSystem]
readsPrec :: Int -> ReadS FileSystem
$creadsPrec :: Int -> ReadS FileSystem
Read, Typeable, Typeable FileSystem
DataType
Constr
Typeable FileSystem
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FileSystem -> c FileSystem)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FileSystem)
-> (FileSystem -> Constr)
-> (FileSystem -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FileSystem))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FileSystem))
-> ((forall b. Data b => b -> b) -> FileSystem -> FileSystem)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FileSystem -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FileSystem -> r)
-> (forall u. (forall d. Data d => d -> u) -> FileSystem -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FileSystem -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem)
-> Data FileSystem
FileSystem -> DataType
FileSystem -> Constr
(forall b. Data b => b -> b) -> FileSystem -> FileSystem
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileSystem -> c FileSystem
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileSystem
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FileSystem -> u
forall u. (forall d. Data d => d -> u) -> FileSystem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileSystem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileSystem -> c FileSystem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FileSystem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileSystem)
$cVFAT :: Constr
$cISO9660 :: Constr
$cExt4_64 :: Constr
$cExt4 :: Constr
$cNoFileSystem :: Constr
$tFileSystem :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
gmapMp :: (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
gmapM :: (forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FileSystem -> m FileSystem
gmapQi :: Int -> (forall d. Data d => d -> u) -> FileSystem -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FileSystem -> u
gmapQ :: (forall d. Data d => d -> u) -> FileSystem -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FileSystem -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileSystem -> r
gmapT :: (forall b. Data b => b -> b) -> FileSystem -> FileSystem
$cgmapT :: (forall b. Data b => b -> b) -> FileSystem -> FileSystem
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileSystem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileSystem)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FileSystem)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FileSystem)
dataTypeOf :: FileSystem -> DataType
$cdataTypeOf :: FileSystem -> DataType
toConstr :: FileSystem -> Constr
$ctoConstr :: FileSystem -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileSystem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileSystem
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileSystem -> c FileSystem
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileSystem -> c FileSystem
$cp1Data :: Typeable FileSystem
Data, (forall x. FileSystem -> Rep FileSystem x)
-> (forall x. Rep FileSystem x -> FileSystem) -> Generic FileSystem
forall x. Rep FileSystem x -> FileSystem
forall x. FileSystem -> Rep FileSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileSystem x -> FileSystem
$cfrom :: forall x. FileSystem -> Rep FileSystem x
Generic)

instance Function FileSystem

instance CoArbitrary FileSystem

instance Hashable FileSystem

instance Binary FileSystem

instance NFData FileSystem

-- | A data type for image file or file system size; instead of passing 'Int's
-- around this also captures a size unit so that the 'Int' can be kept small
data ImageSize = ImageSize Int SizeUnit
  deriving (ImageSize -> ImageSize -> Bool
(ImageSize -> ImageSize -> Bool)
-> (ImageSize -> ImageSize -> Bool) -> Eq ImageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageSize -> ImageSize -> Bool
$c/= :: ImageSize -> ImageSize -> Bool
== :: ImageSize -> ImageSize -> Bool
$c== :: ImageSize -> ImageSize -> Bool
Eq, Int -> ImageSize -> ShowS
[ImageSize] -> ShowS
ImageSize -> String
(Int -> ImageSize -> ShowS)
-> (ImageSize -> String)
-> ([ImageSize] -> ShowS)
-> Show ImageSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageSize] -> ShowS
$cshowList :: [ImageSize] -> ShowS
show :: ImageSize -> String
$cshow :: ImageSize -> String
showsPrec :: Int -> ImageSize -> ShowS
$cshowsPrec :: Int -> ImageSize -> ShowS
Show, ReadPrec [ImageSize]
ReadPrec ImageSize
Int -> ReadS ImageSize
ReadS [ImageSize]
(Int -> ReadS ImageSize)
-> ReadS [ImageSize]
-> ReadPrec ImageSize
-> ReadPrec [ImageSize]
-> Read ImageSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageSize]
$creadListPrec :: ReadPrec [ImageSize]
readPrec :: ReadPrec ImageSize
$creadPrec :: ReadPrec ImageSize
readList :: ReadS [ImageSize]
$creadList :: ReadS [ImageSize]
readsPrec :: Int -> ReadS ImageSize
$creadsPrec :: Int -> ReadS ImageSize
Read, Typeable, Typeable ImageSize
DataType
Constr
Typeable ImageSize
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageSize -> c ImageSize)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageSize)
-> (ImageSize -> Constr)
-> (ImageSize -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageSize))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageSize))
-> ((forall b. Data b => b -> b) -> ImageSize -> ImageSize)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageSize -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageSize -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImageSize -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageSize -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize)
-> Data ImageSize
ImageSize -> DataType
ImageSize -> Constr
(forall b. Data b => b -> b) -> ImageSize -> ImageSize
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSize -> c ImageSize
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSize
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImageSize -> u
forall u. (forall d. Data d => d -> u) -> ImageSize -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSize
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSize -> c ImageSize
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageSize)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageSize)
$cImageSize :: Constr
$tImageSize :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
gmapMp :: (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
gmapM :: (forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageSize -> m ImageSize
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageSize -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImageSize -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageSize -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageSize -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageSize -> r
gmapT :: (forall b. Data b => b -> b) -> ImageSize -> ImageSize
$cgmapT :: (forall b. Data b => b -> b) -> ImageSize -> ImageSize
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageSize)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImageSize)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageSize)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageSize)
dataTypeOf :: ImageSize -> DataType
$cdataTypeOf :: ImageSize -> DataType
toConstr :: ImageSize -> Constr
$ctoConstr :: ImageSize -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSize
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageSize
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSize -> c ImageSize
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageSize -> c ImageSize
$cp1Data :: Typeable ImageSize
Data, (forall x. ImageSize -> Rep ImageSize x)
-> (forall x. Rep ImageSize x -> ImageSize) -> Generic ImageSize
forall x. Rep ImageSize x -> ImageSize
forall x. ImageSize -> Rep ImageSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageSize x -> ImageSize
$cfrom :: forall x. ImageSize -> Rep ImageSize x
Generic)

instance Hashable ImageSize

instance Binary ImageSize

instance NFData ImageSize

-- | Convert a size in bytes to an 'ImageSize'
bytesToKiloBytes :: Int -> ImageSize
bytesToKiloBytes :: Int -> ImageSize
bytesToKiloBytes Int
x =
  let kbRoundedDown :: Int
kbRoundedDown = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024
      rest :: Int
rest = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1024
      kbRoundedUp :: Int
kbRoundedUp = if Int
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
kbRoundedDown Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
kbRoundedDown
   in Int -> SizeUnit -> ImageSize
ImageSize Int
kbRoundedUp SizeUnit
KB

-- | Convert an 'ImageSize' to kibi bytes.
imageSizeToKiB :: ImageSize -> Int
imageSizeToKiB :: ImageSize -> Int
imageSizeToKiB (ImageSize Int
size SizeUnit
unit) =
  Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeUnit -> Int
sizeUnitKiB SizeUnit
unit

-- | Convert a 'SizeUnit' to the number of kibi bytes one element represents.
sizeUnitKiB :: SizeUnit -> Int
sizeUnitKiB :: SizeUnit -> Int
sizeUnitKiB SizeUnit
GB = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeUnit -> Int
sizeUnitKiB SizeUnit
MB
sizeUnitKiB SizeUnit
MB = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeUnit -> Int
sizeUnitKiB SizeUnit
KB
sizeUnitKiB SizeUnit
KB = Int
1

-- | Choose the greatest unit possible to exactly represent an 'ImageSize'.
normalizeSize :: ImageSize -> ImageSize
normalizeSize :: ImageSize -> ImageSize
normalizeSize i :: ImageSize
i@(ImageSize Int
_ SizeUnit
GB) = ImageSize
i
normalizeSize i :: ImageSize
i@(ImageSize Int
size SizeUnit
unit)
  | Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1024 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
    ImageSize -> ImageSize
normalizeSize (Int -> SizeUnit -> ImageSize
ImageSize (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024) (SizeUnit -> SizeUnit
forall a. Enum a => a -> a
succ SizeUnit
unit))
  | Bool
otherwise = ImageSize
i

-- | Return the sum of two @'ImageSize's@.
addImageSize :: ImageSize -> ImageSize -> ImageSize
-- of course we could get more fancy, but is it really needed? The file size will always be bytes ...
addImageSize :: ImageSize -> ImageSize -> ImageSize
addImageSize (ImageSize Int
value SizeUnit
unit) (ImageSize Int
value' SizeUnit
unit') =
  ImageSize -> ImageSize
normalizeSize
    (Int -> SizeUnit -> ImageSize
ImageSize (Int
value Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeUnit -> Int
sizeUnitKiB SizeUnit
unit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
value' Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeUnit -> Int
sizeUnitKiB SizeUnit
unit') SizeUnit
KB)

-- | Enumeration of size multipliers. The exact semantics may vary depending on
-- what external tools look at these. E.g. the size unit is convert to a size
-- parameter of the @qemu-img@ command line tool.
data SizeUnit = KB | MB | GB
  deriving (SizeUnit -> SizeUnit -> Bool
(SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool) -> Eq SizeUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizeUnit -> SizeUnit -> Bool
$c/= :: SizeUnit -> SizeUnit -> Bool
== :: SizeUnit -> SizeUnit -> Bool
$c== :: SizeUnit -> SizeUnit -> Bool
Eq, Int -> SizeUnit -> ShowS
[SizeUnit] -> ShowS
SizeUnit -> String
(Int -> SizeUnit -> ShowS)
-> (SizeUnit -> String) -> ([SizeUnit] -> ShowS) -> Show SizeUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizeUnit] -> ShowS
$cshowList :: [SizeUnit] -> ShowS
show :: SizeUnit -> String
$cshow :: SizeUnit -> String
showsPrec :: Int -> SizeUnit -> ShowS
$cshowsPrec :: Int -> SizeUnit -> ShowS
Show, ReadPrec [SizeUnit]
ReadPrec SizeUnit
Int -> ReadS SizeUnit
ReadS [SizeUnit]
(Int -> ReadS SizeUnit)
-> ReadS [SizeUnit]
-> ReadPrec SizeUnit
-> ReadPrec [SizeUnit]
-> Read SizeUnit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SizeUnit]
$creadListPrec :: ReadPrec [SizeUnit]
readPrec :: ReadPrec SizeUnit
$creadPrec :: ReadPrec SizeUnit
readList :: ReadS [SizeUnit]
$creadList :: ReadS [SizeUnit]
readsPrec :: Int -> ReadS SizeUnit
$creadsPrec :: Int -> ReadS SizeUnit
Read, Eq SizeUnit
Eq SizeUnit
-> (SizeUnit -> SizeUnit -> Ordering)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> SizeUnit)
-> (SizeUnit -> SizeUnit -> SizeUnit)
-> Ord SizeUnit
SizeUnit -> SizeUnit -> Bool
SizeUnit -> SizeUnit -> Ordering
SizeUnit -> SizeUnit -> SizeUnit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SizeUnit -> SizeUnit -> SizeUnit
$cmin :: SizeUnit -> SizeUnit -> SizeUnit
max :: SizeUnit -> SizeUnit -> SizeUnit
$cmax :: SizeUnit -> SizeUnit -> SizeUnit
>= :: SizeUnit -> SizeUnit -> Bool
$c>= :: SizeUnit -> SizeUnit -> Bool
> :: SizeUnit -> SizeUnit -> Bool
$c> :: SizeUnit -> SizeUnit -> Bool
<= :: SizeUnit -> SizeUnit -> Bool
$c<= :: SizeUnit -> SizeUnit -> Bool
< :: SizeUnit -> SizeUnit -> Bool
$c< :: SizeUnit -> SizeUnit -> Bool
compare :: SizeUnit -> SizeUnit -> Ordering
$ccompare :: SizeUnit -> SizeUnit -> Ordering
$cp1Ord :: Eq SizeUnit
Ord, Int -> SizeUnit
SizeUnit -> Int
SizeUnit -> [SizeUnit]
SizeUnit -> SizeUnit
SizeUnit -> SizeUnit -> [SizeUnit]
SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
(SizeUnit -> SizeUnit)
-> (SizeUnit -> SizeUnit)
-> (Int -> SizeUnit)
-> (SizeUnit -> Int)
-> (SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit])
-> Enum SizeUnit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromThenTo :: SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
enumFromTo :: SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromTo :: SizeUnit -> SizeUnit -> [SizeUnit]
enumFromThen :: SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromThen :: SizeUnit -> SizeUnit -> [SizeUnit]
enumFrom :: SizeUnit -> [SizeUnit]
$cenumFrom :: SizeUnit -> [SizeUnit]
fromEnum :: SizeUnit -> Int
$cfromEnum :: SizeUnit -> Int
toEnum :: Int -> SizeUnit
$ctoEnum :: Int -> SizeUnit
pred :: SizeUnit -> SizeUnit
$cpred :: SizeUnit -> SizeUnit
succ :: SizeUnit -> SizeUnit
$csucc :: SizeUnit -> SizeUnit
Enum, SizeUnit
SizeUnit -> SizeUnit -> Bounded SizeUnit
forall a. a -> a -> Bounded a
maxBound :: SizeUnit
$cmaxBound :: SizeUnit
minBound :: SizeUnit
$cminBound :: SizeUnit
Bounded, Typeable, Typeable SizeUnit
DataType
Constr
Typeable SizeUnit
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SizeUnit -> c SizeUnit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SizeUnit)
-> (SizeUnit -> Constr)
-> (SizeUnit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SizeUnit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SizeUnit))
-> ((forall b. Data b => b -> b) -> SizeUnit -> SizeUnit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SizeUnit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SizeUnit -> r)
-> (forall u. (forall d. Data d => d -> u) -> SizeUnit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SizeUnit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit)
-> Data SizeUnit
SizeUnit -> DataType
SizeUnit -> Constr
(forall b. Data b => b -> b) -> SizeUnit -> SizeUnit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SizeUnit -> c SizeUnit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SizeUnit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SizeUnit -> u
forall u. (forall d. Data d => d -> u) -> SizeUnit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SizeUnit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SizeUnit -> c SizeUnit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SizeUnit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SizeUnit)
$cGB :: Constr
$cMB :: Constr
$cKB :: Constr
$tSizeUnit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
gmapMp :: (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
gmapM :: (forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SizeUnit -> m SizeUnit
gmapQi :: Int -> (forall d. Data d => d -> u) -> SizeUnit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SizeUnit -> u
gmapQ :: (forall d. Data d => d -> u) -> SizeUnit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SizeUnit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SizeUnit -> r
gmapT :: (forall b. Data b => b -> b) -> SizeUnit -> SizeUnit
$cgmapT :: (forall b. Data b => b -> b) -> SizeUnit -> SizeUnit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SizeUnit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SizeUnit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SizeUnit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SizeUnit)
dataTypeOf :: SizeUnit -> DataType
$cdataTypeOf :: SizeUnit -> DataType
toConstr :: SizeUnit -> Constr
$ctoConstr :: SizeUnit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SizeUnit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SizeUnit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SizeUnit -> c SizeUnit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SizeUnit -> c SizeUnit
$cp1Data :: Typeable SizeUnit
Data, (forall x. SizeUnit -> Rep SizeUnit x)
-> (forall x. Rep SizeUnit x -> SizeUnit) -> Generic SizeUnit
forall x. Rep SizeUnit x -> SizeUnit
forall x. SizeUnit -> Rep SizeUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SizeUnit x -> SizeUnit
$cfrom :: forall x. SizeUnit -> Rep SizeUnit x
Generic)

instance Hashable SizeUnit

instance Binary SizeUnit

instance NFData SizeUnit

-- | How to resize an image file.
data ImageResize
  = -- | Resize the image __but not the file system__. Note that
    -- a file system contained in the image file might be
    -- corrupted by this operation. To not only resize the image
    -- file but also the fil system contained in it, use
    -- 'Resize'.
    ResizeImage ImageSize
  | -- | Resize an image and the contained file system.
    Resize ImageSize
  | -- | Shrink to minimum size needed and increase by the amount given.
    ShrinkToMinimumAndIncrease ImageSize
  | -- | Resize an image and the contained file system to the
    -- smallest size to fit the contents of the file system.
    ShrinkToMinimum
  | -- | Do not change the image size.
    KeepSize
  deriving (ImageResize -> ImageResize -> Bool
(ImageResize -> ImageResize -> Bool)
-> (ImageResize -> ImageResize -> Bool) -> Eq ImageResize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageResize -> ImageResize -> Bool
$c/= :: ImageResize -> ImageResize -> Bool
== :: ImageResize -> ImageResize -> Bool
$c== :: ImageResize -> ImageResize -> Bool
Eq, Int -> ImageResize -> ShowS
[ImageResize] -> ShowS
ImageResize -> String
(Int -> ImageResize -> ShowS)
-> (ImageResize -> String)
-> ([ImageResize] -> ShowS)
-> Show ImageResize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageResize] -> ShowS
$cshowList :: [ImageResize] -> ShowS
show :: ImageResize -> String
$cshow :: ImageResize -> String
showsPrec :: Int -> ImageResize -> ShowS
$cshowsPrec :: Int -> ImageResize -> ShowS
Show, ReadPrec [ImageResize]
ReadPrec ImageResize
Int -> ReadS ImageResize
ReadS [ImageResize]
(Int -> ReadS ImageResize)
-> ReadS [ImageResize]
-> ReadPrec ImageResize
-> ReadPrec [ImageResize]
-> Read ImageResize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageResize]
$creadListPrec :: ReadPrec [ImageResize]
readPrec :: ReadPrec ImageResize
$creadPrec :: ReadPrec ImageResize
readList :: ReadS [ImageResize]
$creadList :: ReadS [ImageResize]
readsPrec :: Int -> ReadS ImageResize
$creadsPrec :: Int -> ReadS ImageResize
Read, Typeable, Typeable ImageResize
DataType
Constr
Typeable ImageResize
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ImageResize -> c ImageResize)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImageResize)
-> (ImageResize -> Constr)
-> (ImageResize -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImageResize))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImageResize))
-> ((forall b. Data b => b -> b) -> ImageResize -> ImageResize)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageResize -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImageResize -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImageResize -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImageResize -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize)
-> Data ImageResize
ImageResize -> DataType
ImageResize -> Constr
(forall b. Data b => b -> b) -> ImageResize -> ImageResize
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageResize -> c ImageResize
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageResize
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImageResize -> u
forall u. (forall d. Data d => d -> u) -> ImageResize -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageResize
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageResize -> c ImageResize
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageResize)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageResize)
$cKeepSize :: Constr
$cShrinkToMinimum :: Constr
$cShrinkToMinimumAndIncrease :: Constr
$cResize :: Constr
$cResizeImage :: Constr
$tImageResize :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
gmapMp :: (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
gmapM :: (forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImageResize -> m ImageResize
gmapQi :: Int -> (forall d. Data d => d -> u) -> ImageResize -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImageResize -> u
gmapQ :: (forall d. Data d => d -> u) -> ImageResize -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImageResize -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImageResize -> r
gmapT :: (forall b. Data b => b -> b) -> ImageResize -> ImageResize
$cgmapT :: (forall b. Data b => b -> b) -> ImageResize -> ImageResize
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageResize)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImageResize)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ImageResize)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImageResize)
dataTypeOf :: ImageResize -> DataType
$cdataTypeOf :: ImageResize -> DataType
toConstr :: ImageResize -> Constr
$ctoConstr :: ImageResize -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageResize
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImageResize
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageResize -> c ImageResize
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImageResize -> c ImageResize
$cp1Data :: Typeable ImageResize
Data, (forall x. ImageResize -> Rep ImageResize x)
-> (forall x. Rep ImageResize x -> ImageResize)
-> Generic ImageResize
forall x. Rep ImageResize x -> ImageResize
forall x. ImageResize -> Rep ImageResize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageResize x -> ImageResize
$cfrom :: forall x. ImageResize -> Rep ImageResize x
Generic)

instance Hashable ImageResize

instance Binary ImageResize

instance NFData ImageResize

-- | A type alias that indicates that something of type @a@ is mount at a
-- 'MountPoint'
type Mounted a = (a, MountPoint)

-- * Shared Images

-- | 'SharedImage' holds all data necessary to describe an __instance__ of a shared
--    image identified by a 'SharedImageName'. Shared images are stored in
--    'B9.Repository's.
data SharedImage
  = SharedImage
      SharedImageName
      SharedImageDate
      SharedImageBuildId
      ImageType
      FileSystem
  deriving (SharedImage -> SharedImage -> Bool
(SharedImage -> SharedImage -> Bool)
-> (SharedImage -> SharedImage -> Bool) -> Eq SharedImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedImage -> SharedImage -> Bool
$c/= :: SharedImage -> SharedImage -> Bool
== :: SharedImage -> SharedImage -> Bool
$c== :: SharedImage -> SharedImage -> Bool
Eq, ReadPrec [SharedImage]
ReadPrec SharedImage
Int -> ReadS SharedImage
ReadS [SharedImage]
(Int -> ReadS SharedImage)
-> ReadS [SharedImage]
-> ReadPrec SharedImage
-> ReadPrec [SharedImage]
-> Read SharedImage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SharedImage]
$creadListPrec :: ReadPrec [SharedImage]
readPrec :: ReadPrec SharedImage
$creadPrec :: ReadPrec SharedImage
readList :: ReadS [SharedImage]
$creadList :: ReadS [SharedImage]
readsPrec :: Int -> ReadS SharedImage
$creadsPrec :: Int -> ReadS SharedImage
Read, Int -> SharedImage -> ShowS
[SharedImage] -> ShowS
SharedImage -> String
(Int -> SharedImage -> ShowS)
-> (SharedImage -> String)
-> ([SharedImage] -> ShowS)
-> Show SharedImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedImage] -> ShowS
$cshowList :: [SharedImage] -> ShowS
show :: SharedImage -> String
$cshow :: SharedImage -> String
showsPrec :: Int -> SharedImage -> ShowS
$cshowsPrec :: Int -> SharedImage -> ShowS
Show, Typeable, Typeable SharedImage
DataType
Constr
Typeable SharedImage
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SharedImage -> c SharedImage)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SharedImage)
-> (SharedImage -> Constr)
-> (SharedImage -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SharedImage))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SharedImage))
-> ((forall b. Data b => b -> b) -> SharedImage -> SharedImage)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImage -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImage -> r)
-> (forall u. (forall d. Data d => d -> u) -> SharedImage -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SharedImage -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage)
-> Data SharedImage
SharedImage -> DataType
SharedImage -> Constr
(forall b. Data b => b -> b) -> SharedImage -> SharedImage
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImage -> c SharedImage
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImage
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SharedImage -> u
forall u. (forall d. Data d => d -> u) -> SharedImage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImage -> c SharedImage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImage)
$cSharedImage :: Constr
$tSharedImage :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
gmapMp :: (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
gmapM :: (forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SharedImage -> m SharedImage
gmapQi :: Int -> (forall d. Data d => d -> u) -> SharedImage -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SharedImage -> u
gmapQ :: (forall d. Data d => d -> u) -> SharedImage -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SharedImage -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImage -> r
gmapT :: (forall b. Data b => b -> b) -> SharedImage -> SharedImage
$cgmapT :: (forall b. Data b => b -> b) -> SharedImage -> SharedImage
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImage)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SharedImage)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImage)
dataTypeOf :: SharedImage -> DataType
$cdataTypeOf :: SharedImage -> DataType
toConstr :: SharedImage -> Constr
$ctoConstr :: SharedImage -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImage
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImage -> c SharedImage
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImage -> c SharedImage
$cp1Data :: Typeable SharedImage
Data, (forall x. SharedImage -> Rep SharedImage x)
-> (forall x. Rep SharedImage x -> SharedImage)
-> Generic SharedImage
forall x. Rep SharedImage x -> SharedImage
forall x. SharedImage -> Rep SharedImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SharedImage x -> SharedImage
$cfrom :: forall x. SharedImage -> Rep SharedImage x
Generic)

instance Arbitrary SharedImage where
  arbitrary :: Gen SharedImage
arbitrary =
    SharedImageName
-> SharedImageDate
-> SharedImageBuildId
-> ImageType
-> FileSystem
-> SharedImage
SharedImage
      (SharedImageName
 -> SharedImageDate
 -> SharedImageBuildId
 -> ImageType
 -> FileSystem
 -> SharedImage)
-> Gen SharedImageName
-> Gen
     (SharedImageDate
      -> SharedImageBuildId -> ImageType -> FileSystem -> SharedImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SharedImageName -> Gen SharedImageName
forall a. Gen a -> Gen a
smaller Gen SharedImageName
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (SharedImageDate
   -> SharedImageBuildId -> ImageType -> FileSystem -> SharedImage)
-> Gen SharedImageDate
-> Gen
     (SharedImageBuildId -> ImageType -> FileSystem -> SharedImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SharedImageDate -> Gen SharedImageDate
forall a. Gen a -> Gen a
smaller Gen SharedImageDate
forall a. Arbitrary a => Gen a
arbitrary
      Gen (SharedImageBuildId -> ImageType -> FileSystem -> SharedImage)
-> Gen SharedImageBuildId
-> Gen (ImageType -> FileSystem -> SharedImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SharedImageBuildId -> Gen SharedImageBuildId
forall a. Gen a -> Gen a
smaller Gen SharedImageBuildId
forall a. Arbitrary a => Gen a
arbitrary
      Gen (ImageType -> FileSystem -> SharedImage)
-> Gen ImageType -> Gen (FileSystem -> SharedImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageType -> Gen ImageType
forall a. Gen a -> Gen a
smaller Gen ImageType
forall a. Arbitrary a => Gen a
arbitrary
      Gen (FileSystem -> SharedImage)
-> Gen FileSystem -> Gen SharedImage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FileSystem -> Gen FileSystem
forall a. Gen a -> Gen a
smaller Gen FileSystem
forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary SharedImage

instance Function SharedImage

instance Hashable SharedImage

instance Binary SharedImage

instance NFData SharedImage

-- | The name of the image is the de-facto identifier for push, pull, 'From' and
--   'Share'.  B9 always selects the newest version the shared image identified
--   by that name when using a shared image as an 'ImageSource'. This is a
--   wrapper around a string that identifies a 'SharedImage'
newtype SharedImageName
  = SharedImageName String
  deriving (SharedImageName -> SharedImageName -> Bool
(SharedImageName -> SharedImageName -> Bool)
-> (SharedImageName -> SharedImageName -> Bool)
-> Eq SharedImageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedImageName -> SharedImageName -> Bool
$c/= :: SharedImageName -> SharedImageName -> Bool
== :: SharedImageName -> SharedImageName -> Bool
$c== :: SharedImageName -> SharedImageName -> Bool
Eq, Eq SharedImageName
Eq SharedImageName
-> (SharedImageName -> SharedImageName -> Ordering)
-> (SharedImageName -> SharedImageName -> Bool)
-> (SharedImageName -> SharedImageName -> Bool)
-> (SharedImageName -> SharedImageName -> Bool)
-> (SharedImageName -> SharedImageName -> Bool)
-> (SharedImageName -> SharedImageName -> SharedImageName)
-> (SharedImageName -> SharedImageName -> SharedImageName)
-> Ord SharedImageName
SharedImageName -> SharedImageName -> Bool
SharedImageName -> SharedImageName -> Ordering
SharedImageName -> SharedImageName -> SharedImageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SharedImageName -> SharedImageName -> SharedImageName
$cmin :: SharedImageName -> SharedImageName -> SharedImageName
max :: SharedImageName -> SharedImageName -> SharedImageName
$cmax :: SharedImageName -> SharedImageName -> SharedImageName
>= :: SharedImageName -> SharedImageName -> Bool
$c>= :: SharedImageName -> SharedImageName -> Bool
> :: SharedImageName -> SharedImageName -> Bool
$c> :: SharedImageName -> SharedImageName -> Bool
<= :: SharedImageName -> SharedImageName -> Bool
$c<= :: SharedImageName -> SharedImageName -> Bool
< :: SharedImageName -> SharedImageName -> Bool
$c< :: SharedImageName -> SharedImageName -> Bool
compare :: SharedImageName -> SharedImageName -> Ordering
$ccompare :: SharedImageName -> SharedImageName -> Ordering
$cp1Ord :: Eq SharedImageName
Ord, ReadPrec [SharedImageName]
ReadPrec SharedImageName
Int -> ReadS SharedImageName
ReadS [SharedImageName]
(Int -> ReadS SharedImageName)
-> ReadS [SharedImageName]
-> ReadPrec SharedImageName
-> ReadPrec [SharedImageName]
-> Read SharedImageName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SharedImageName]
$creadListPrec :: ReadPrec [SharedImageName]
readPrec :: ReadPrec SharedImageName
$creadPrec :: ReadPrec SharedImageName
readList :: ReadS [SharedImageName]
$creadList :: ReadS [SharedImageName]
readsPrec :: Int -> ReadS SharedImageName
$creadsPrec :: Int -> ReadS SharedImageName
Read, Int -> SharedImageName -> ShowS
[SharedImageName] -> ShowS
SharedImageName -> String
(Int -> SharedImageName -> ShowS)
-> (SharedImageName -> String)
-> ([SharedImageName] -> ShowS)
-> Show SharedImageName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedImageName] -> ShowS
$cshowList :: [SharedImageName] -> ShowS
show :: SharedImageName -> String
$cshow :: SharedImageName -> String
showsPrec :: Int -> SharedImageName -> ShowS
$cshowsPrec :: Int -> SharedImageName -> ShowS
Show, Typeable, Typeable SharedImageName
DataType
Constr
Typeable SharedImageName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SharedImageName -> c SharedImageName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SharedImageName)
-> (SharedImageName -> Constr)
-> (SharedImageName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SharedImageName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SharedImageName))
-> ((forall b. Data b => b -> b)
    -> SharedImageName -> SharedImageName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SharedImageName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SharedImageName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SharedImageName -> m SharedImageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageName -> m SharedImageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageName -> m SharedImageName)
-> Data SharedImageName
SharedImageName -> DataType
SharedImageName -> Constr
(forall b. Data b => b -> b) -> SharedImageName -> SharedImageName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageName -> c SharedImageName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageName -> u
forall u. (forall d. Data d => d -> u) -> SharedImageName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageName -> c SharedImageName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageName)
$cSharedImageName :: Constr
$tSharedImageName :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
gmapMp :: (forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
gmapM :: (forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageName -> m SharedImageName
gmapQi :: Int -> (forall d. Data d => d -> u) -> SharedImageName -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageName -> u
gmapQ :: (forall d. Data d => d -> u) -> SharedImageName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SharedImageName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageName -> r
gmapT :: (forall b. Data b => b -> b) -> SharedImageName -> SharedImageName
$cgmapT :: (forall b. Data b => b -> b) -> SharedImageName -> SharedImageName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SharedImageName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageName)
dataTypeOf :: SharedImageName -> DataType
$cdataTypeOf :: SharedImageName -> DataType
toConstr :: SharedImageName -> Constr
$ctoConstr :: SharedImageName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageName -> c SharedImageName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageName -> c SharedImageName
$cp1Data :: Typeable SharedImageName
Data, Int -> SharedImageName -> Int
SharedImageName -> Int
(Int -> SharedImageName -> Int)
-> (SharedImageName -> Int) -> Hashable SharedImageName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SharedImageName -> Int
$chash :: SharedImageName -> Int
hashWithSalt :: Int -> SharedImageName -> Int
$chashWithSalt :: Int -> SharedImageName -> Int
Hashable, Get SharedImageName
[SharedImageName] -> Put
SharedImageName -> Put
(SharedImageName -> Put)
-> Get SharedImageName
-> ([SharedImageName] -> Put)
-> Binary SharedImageName
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SharedImageName] -> Put
$cputList :: [SharedImageName] -> Put
get :: Get SharedImageName
$cget :: Get SharedImageName
put :: SharedImageName -> Put
$cput :: SharedImageName -> Put
Binary, SharedImageName -> ()
(SharedImageName -> ()) -> NFData SharedImageName
forall a. (a -> ()) -> NFData a
rnf :: SharedImageName -> ()
$crnf :: SharedImageName -> ()
NFData, SharedImageName -> Gen b -> Gen b
(forall b. SharedImageName -> Gen b -> Gen b)
-> CoArbitrary SharedImageName
forall b. SharedImageName -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: SharedImageName -> Gen b -> Gen b
$ccoarbitrary :: forall b. SharedImageName -> Gen b -> Gen b
CoArbitrary)

-- | Get the String representation of a 'SharedImageName'.
fromSharedImageName :: SharedImageName -> String
fromSharedImageName :: SharedImageName -> String
fromSharedImageName (SharedImageName String
b) = String
b

-- | The exact time that build job __started__.
--   This is a wrapper around a string contains the build date of a
--   'SharedImage'; this is purely additional convenience and typesafety
newtype SharedImageDate
  = SharedImageDate String
  deriving (SharedImageDate -> SharedImageDate -> Bool
(SharedImageDate -> SharedImageDate -> Bool)
-> (SharedImageDate -> SharedImageDate -> Bool)
-> Eq SharedImageDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedImageDate -> SharedImageDate -> Bool
$c/= :: SharedImageDate -> SharedImageDate -> Bool
== :: SharedImageDate -> SharedImageDate -> Bool
$c== :: SharedImageDate -> SharedImageDate -> Bool
Eq, Eq SharedImageDate
Eq SharedImageDate
-> (SharedImageDate -> SharedImageDate -> Ordering)
-> (SharedImageDate -> SharedImageDate -> Bool)
-> (SharedImageDate -> SharedImageDate -> Bool)
-> (SharedImageDate -> SharedImageDate -> Bool)
-> (SharedImageDate -> SharedImageDate -> Bool)
-> (SharedImageDate -> SharedImageDate -> SharedImageDate)
-> (SharedImageDate -> SharedImageDate -> SharedImageDate)
-> Ord SharedImageDate
SharedImageDate -> SharedImageDate -> Bool
SharedImageDate -> SharedImageDate -> Ordering
SharedImageDate -> SharedImageDate -> SharedImageDate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SharedImageDate -> SharedImageDate -> SharedImageDate
$cmin :: SharedImageDate -> SharedImageDate -> SharedImageDate
max :: SharedImageDate -> SharedImageDate -> SharedImageDate
$cmax :: SharedImageDate -> SharedImageDate -> SharedImageDate
>= :: SharedImageDate -> SharedImageDate -> Bool
$c>= :: SharedImageDate -> SharedImageDate -> Bool
> :: SharedImageDate -> SharedImageDate -> Bool
$c> :: SharedImageDate -> SharedImageDate -> Bool
<= :: SharedImageDate -> SharedImageDate -> Bool
$c<= :: SharedImageDate -> SharedImageDate -> Bool
< :: SharedImageDate -> SharedImageDate -> Bool
$c< :: SharedImageDate -> SharedImageDate -> Bool
compare :: SharedImageDate -> SharedImageDate -> Ordering
$ccompare :: SharedImageDate -> SharedImageDate -> Ordering
$cp1Ord :: Eq SharedImageDate
Ord, ReadPrec [SharedImageDate]
ReadPrec SharedImageDate
Int -> ReadS SharedImageDate
ReadS [SharedImageDate]
(Int -> ReadS SharedImageDate)
-> ReadS [SharedImageDate]
-> ReadPrec SharedImageDate
-> ReadPrec [SharedImageDate]
-> Read SharedImageDate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SharedImageDate]
$creadListPrec :: ReadPrec [SharedImageDate]
readPrec :: ReadPrec SharedImageDate
$creadPrec :: ReadPrec SharedImageDate
readList :: ReadS [SharedImageDate]
$creadList :: ReadS [SharedImageDate]
readsPrec :: Int -> ReadS SharedImageDate
$creadsPrec :: Int -> ReadS SharedImageDate
Read, Int -> SharedImageDate -> ShowS
[SharedImageDate] -> ShowS
SharedImageDate -> String
(Int -> SharedImageDate -> ShowS)
-> (SharedImageDate -> String)
-> ([SharedImageDate] -> ShowS)
-> Show SharedImageDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedImageDate] -> ShowS
$cshowList :: [SharedImageDate] -> ShowS
show :: SharedImageDate -> String
$cshow :: SharedImageDate -> String
showsPrec :: Int -> SharedImageDate -> ShowS
$cshowsPrec :: Int -> SharedImageDate -> ShowS
Show, Typeable, Typeable SharedImageDate
DataType
Constr
Typeable SharedImageDate
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SharedImageDate -> c SharedImageDate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SharedImageDate)
-> (SharedImageDate -> Constr)
-> (SharedImageDate -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SharedImageDate))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SharedImageDate))
-> ((forall b. Data b => b -> b)
    -> SharedImageDate -> SharedImageDate)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SharedImageDate -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SharedImageDate -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SharedImageDate -> m SharedImageDate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageDate -> m SharedImageDate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageDate -> m SharedImageDate)
-> Data SharedImageDate
SharedImageDate -> DataType
SharedImageDate -> Constr
(forall b. Data b => b -> b) -> SharedImageDate -> SharedImageDate
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageDate -> c SharedImageDate
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageDate
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageDate -> u
forall u. (forall d. Data d => d -> u) -> SharedImageDate -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageDate
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageDate -> c SharedImageDate
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageDate)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageDate)
$cSharedImageDate :: Constr
$tSharedImageDate :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
gmapMp :: (forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
gmapM :: (forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageDate -> m SharedImageDate
gmapQi :: Int -> (forall d. Data d => d -> u) -> SharedImageDate -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageDate -> u
gmapQ :: (forall d. Data d => d -> u) -> SharedImageDate -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SharedImageDate -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageDate -> r
gmapT :: (forall b. Data b => b -> b) -> SharedImageDate -> SharedImageDate
$cgmapT :: (forall b. Data b => b -> b) -> SharedImageDate -> SharedImageDate
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageDate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageDate)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SharedImageDate)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageDate)
dataTypeOf :: SharedImageDate -> DataType
$cdataTypeOf :: SharedImageDate -> DataType
toConstr :: SharedImageDate -> Constr
$ctoConstr :: SharedImageDate -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageDate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageDate
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageDate -> c SharedImageDate
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SharedImageDate -> c SharedImageDate
$cp1Data :: Typeable SharedImageDate
Data, Int -> SharedImageDate -> Int
SharedImageDate -> Int
(Int -> SharedImageDate -> Int)
-> (SharedImageDate -> Int) -> Hashable SharedImageDate
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SharedImageDate -> Int
$chash :: SharedImageDate -> Int
hashWithSalt :: Int -> SharedImageDate -> Int
$chashWithSalt :: Int -> SharedImageDate -> Int
Hashable, Get SharedImageDate
[SharedImageDate] -> Put
SharedImageDate -> Put
(SharedImageDate -> Put)
-> Get SharedImageDate
-> ([SharedImageDate] -> Put)
-> Binary SharedImageDate
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SharedImageDate] -> Put
$cputList :: [SharedImageDate] -> Put
get :: Get SharedImageDate
$cget :: Get SharedImageDate
put :: SharedImageDate -> Put
$cput :: SharedImageDate -> Put
Binary, SharedImageDate -> ()
(SharedImageDate -> ()) -> NFData SharedImageDate
forall a. (a -> ()) -> NFData a
rnf :: SharedImageDate -> ()
$crnf :: SharedImageDate -> ()
NFData, SharedImageDate -> Gen b -> Gen b
(forall b. SharedImageDate -> Gen b -> Gen b)
-> CoArbitrary SharedImageDate
forall b. SharedImageDate -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: SharedImageDate -> Gen b -> Gen b
$ccoarbitrary :: forall b. SharedImageDate -> Gen b -> Gen b
CoArbitrary)

-- | Every B9 build running in a 'B9Monad'
--   contains a random unique id that is generated once per build (no matter how
--   many artifacts are created in that build) This field contains the build id
--   of the build that created the shared image instance.  This is A wrapper
--   around a string contains the build id of a 'SharedImage'; this is purely
--   additional convenience and typesafety
newtype SharedImageBuildId
  = SharedImageBuildId String
  deriving
    (SharedImageBuildId -> SharedImageBuildId -> Bool
(SharedImageBuildId -> SharedImageBuildId -> Bool)
-> (SharedImageBuildId -> SharedImageBuildId -> Bool)
-> Eq SharedImageBuildId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c/= :: SharedImageBuildId -> SharedImageBuildId -> Bool
== :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c== :: SharedImageBuildId -> SharedImageBuildId -> Bool
Eq, Eq SharedImageBuildId
Eq SharedImageBuildId
-> (SharedImageBuildId -> SharedImageBuildId -> Ordering)
-> (SharedImageBuildId -> SharedImageBuildId -> Bool)
-> (SharedImageBuildId -> SharedImageBuildId -> Bool)
-> (SharedImageBuildId -> SharedImageBuildId -> Bool)
-> (SharedImageBuildId -> SharedImageBuildId -> Bool)
-> (SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId)
-> (SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId)
-> Ord SharedImageBuildId
SharedImageBuildId -> SharedImageBuildId -> Bool
SharedImageBuildId -> SharedImageBuildId -> Ordering
SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId
$cmin :: SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId
max :: SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId
$cmax :: SharedImageBuildId -> SharedImageBuildId -> SharedImageBuildId
>= :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c>= :: SharedImageBuildId -> SharedImageBuildId -> Bool
> :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c> :: SharedImageBuildId -> SharedImageBuildId -> Bool
<= :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c<= :: SharedImageBuildId -> SharedImageBuildId -> Bool
< :: SharedImageBuildId -> SharedImageBuildId -> Bool
$c< :: SharedImageBuildId -> SharedImageBuildId -> Bool
compare :: SharedImageBuildId -> SharedImageBuildId -> Ordering
$ccompare :: SharedImageBuildId -> SharedImageBuildId -> Ordering
$cp1Ord :: Eq SharedImageBuildId
Ord, ReadPrec [SharedImageBuildId]
ReadPrec SharedImageBuildId
Int -> ReadS SharedImageBuildId
ReadS [SharedImageBuildId]
(Int -> ReadS SharedImageBuildId)
-> ReadS [SharedImageBuildId]
-> ReadPrec SharedImageBuildId
-> ReadPrec [SharedImageBuildId]
-> Read SharedImageBuildId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SharedImageBuildId]
$creadListPrec :: ReadPrec [SharedImageBuildId]
readPrec :: ReadPrec SharedImageBuildId
$creadPrec :: ReadPrec SharedImageBuildId
readList :: ReadS [SharedImageBuildId]
$creadList :: ReadS [SharedImageBuildId]
readsPrec :: Int -> ReadS SharedImageBuildId
$creadsPrec :: Int -> ReadS SharedImageBuildId
Read, Int -> SharedImageBuildId -> ShowS
[SharedImageBuildId] -> ShowS
SharedImageBuildId -> String
(Int -> SharedImageBuildId -> ShowS)
-> (SharedImageBuildId -> String)
-> ([SharedImageBuildId] -> ShowS)
-> Show SharedImageBuildId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedImageBuildId] -> ShowS
$cshowList :: [SharedImageBuildId] -> ShowS
show :: SharedImageBuildId -> String
$cshow :: SharedImageBuildId -> String
showsPrec :: Int -> SharedImageBuildId -> ShowS
$cshowsPrec :: Int -> SharedImageBuildId -> ShowS
Show, Typeable, Typeable SharedImageBuildId
DataType
Constr
Typeable SharedImageBuildId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SharedImageBuildId
    -> c SharedImageBuildId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SharedImageBuildId)
-> (SharedImageBuildId -> Constr)
-> (SharedImageBuildId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SharedImageBuildId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SharedImageBuildId))
-> ((forall b. Data b => b -> b)
    -> SharedImageBuildId -> SharedImageBuildId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SharedImageBuildId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SharedImageBuildId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SharedImageBuildId -> m SharedImageBuildId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageBuildId -> m SharedImageBuildId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SharedImageBuildId -> m SharedImageBuildId)
-> Data SharedImageBuildId
SharedImageBuildId -> DataType
SharedImageBuildId -> Constr
(forall b. Data b => b -> b)
-> SharedImageBuildId -> SharedImageBuildId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SharedImageBuildId
-> c SharedImageBuildId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageBuildId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageBuildId -> u
forall u. (forall d. Data d => d -> u) -> SharedImageBuildId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageBuildId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SharedImageBuildId
-> c SharedImageBuildId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageBuildId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageBuildId)
$cSharedImageBuildId :: Constr
$tSharedImageBuildId :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
gmapMp :: (forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
gmapM :: (forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SharedImageBuildId -> m SharedImageBuildId
gmapQi :: Int -> (forall d. Data d => d -> u) -> SharedImageBuildId -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SharedImageBuildId -> u
gmapQ :: (forall d. Data d => d -> u) -> SharedImageBuildId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SharedImageBuildId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SharedImageBuildId -> r
gmapT :: (forall b. Data b => b -> b)
-> SharedImageBuildId -> SharedImageBuildId
$cgmapT :: (forall b. Data b => b -> b)
-> SharedImageBuildId -> SharedImageBuildId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageBuildId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SharedImageBuildId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SharedImageBuildId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SharedImageBuildId)
dataTypeOf :: SharedImageBuildId -> DataType
$cdataTypeOf :: SharedImageBuildId -> DataType
toConstr :: SharedImageBuildId -> Constr
$ctoConstr :: SharedImageBuildId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageBuildId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SharedImageBuildId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SharedImageBuildId
-> c SharedImageBuildId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SharedImageBuildId
-> c SharedImageBuildId
$cp1Data :: Typeable SharedImageBuildId
Data, Int -> SharedImageBuildId -> Int
SharedImageBuildId -> Int
(Int -> SharedImageBuildId -> Int)
-> (SharedImageBuildId -> Int) -> Hashable SharedImageBuildId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SharedImageBuildId -> Int
$chash :: SharedImageBuildId -> Int
hashWithSalt :: Int -> SharedImageBuildId -> Int
$chashWithSalt :: Int -> SharedImageBuildId -> Int
Hashable, Get SharedImageBuildId
[SharedImageBuildId] -> Put
SharedImageBuildId -> Put
(SharedImageBuildId -> Put)
-> Get SharedImageBuildId
-> ([SharedImageBuildId] -> Put)
-> Binary SharedImageBuildId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SharedImageBuildId] -> Put
$cputList :: [SharedImageBuildId] -> Put
get :: Get SharedImageBuildId
$cget :: Get SharedImageBuildId
put :: SharedImageBuildId -> Put
$cput :: SharedImageBuildId -> Put
Binary, SharedImageBuildId -> ()
(SharedImageBuildId -> ()) -> NFData SharedImageBuildId
forall a. (a -> ()) -> NFData a
rnf :: SharedImageBuildId -> ()
$crnf :: SharedImageBuildId -> ()
NFData, SharedImageBuildId -> Gen b -> Gen b
(forall b. SharedImageBuildId -> Gen b -> Gen b)
-> CoArbitrary SharedImageBuildId
forall b. SharedImageBuildId -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: SharedImageBuildId -> Gen b -> Gen b
$ccoarbitrary :: forall b. SharedImageBuildId -> Gen b -> Gen b
CoArbitrary)

-- | Get the String representation of a 'SharedImageBuildId'.
fromSharedImageBuildId :: SharedImageBuildId -> String
fromSharedImageBuildId :: SharedImageBuildId -> String
fromSharedImageBuildId (SharedImageBuildId String
b) = String
b

-- | Shared images are ordered by name, build date and build id
instance Ord SharedImage where
  compare :: SharedImage -> SharedImage -> Ordering
compare (SharedImage SharedImageName
n SharedImageDate
d SharedImageBuildId
b ImageType
_ FileSystem
_) (SharedImage SharedImageName
n' SharedImageDate
d' SharedImageBuildId
b' ImageType
_ FileSystem
_) =
    SharedImageName -> SharedImageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SharedImageName
n SharedImageName
n' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
Sem.<> SharedImageDate -> SharedImageDate -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SharedImageDate
d SharedImageDate
d' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
Sem.<> SharedImageBuildId -> SharedImageBuildId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SharedImageBuildId
b SharedImageBuildId
b'

-- | Transform a list of 'SharedImage' values into a 'Map' that associates
-- each 'SharedImageName' with a 'Set' of the actual images with that name.
--
-- The 'Set' contains values of type  @'SharedImage'@.
--
-- The 'Ord' instance of 'SharedImage' sorts by name first and then by
-- 'sharedImageDate', since the values in a 'Set' share the same 'sharedImageName',
-- they are effectively orderd by build date, which is useful the shared image cleanup.
--
-- @since 1.1.0
sharedImagesToMap :: [SharedImage] -> Map SharedImageName (Set SharedImage)
sharedImagesToMap :: [SharedImage] -> Map SharedImageName (Set SharedImage)
sharedImagesToMap [SharedImage]
_ = String -> Map SharedImageName (Set SharedImage)
forall a. HasCallStack => String -> a
error String
"TODO IMPLEMENT ME"

-- | Return the 'SharedImage' with the highest 'sharedImageDate'.
--
-- @since 1.1.0
takeLatestSharedImage :: [SharedImage] -> Maybe SharedImage
takeLatestSharedImage :: [SharedImage] -> Maybe SharedImage
takeLatestSharedImage [SharedImage]
_ss = do
  String -> Maybe SharedImage
forall a. HasCallStack => String -> a
error String
"TODO IMPLEMENT ME"

-- * Constructor and accessors for 'Image' 'ImageTarget' 'ImageSource'
-- 'ImageDestination' and 'SharedImage'

-- | Return the name of the file corresponding to an 'Image'
imageFileName :: Image -> FilePath
imageFileName :: Image -> String
imageFileName (Image String
f ImageType
_ FileSystem
_) = String
f

-- | Return the 'ImageType' of an 'Image'
imageImageType :: Image -> ImageType
imageImageType :: Image -> ImageType
imageImageType (Image String
_ ImageType
t FileSystem
_) = ImageType
t

-- | Return the files generated for a 'LocalFile' or a 'LiveInstallerImage'; 'SharedImage' and 'Transient'
-- are treated like they have no output files because the output files are manged
-- by B9.
getImageDestinationOutputFiles :: ImageTarget -> [FilePath]
getImageDestinationOutputFiles :: ImageTarget -> [String]
getImageDestinationOutputFiles (ImageTarget ImageDestination
d ImageSource
_ MountPoint
_) = case ImageDestination
d of
  LiveInstallerImage String
liName String
liPath ImageResize
_ ->
    let path :: String
path = String
liPath String -> ShowS
</> String
"machines" String -> ShowS
</> String
liName String -> ShowS
</> String
"disks" String -> ShowS
</> String
"raw"
     in [String
path String -> ShowS
</> String
"0.raw", String
path String -> ShowS
</> String
"0.size", String
path String -> ShowS
</> String
"VERSION"]
  LocalFile (Image String
lfPath ImageType
_ FileSystem
_) ImageResize
_ -> [String
lfPath]
  ImageDestination
_ -> []

-- | Return the name of a shared image, if the 'ImageDestination' is a 'Share'
--   destination
imageDestinationSharedImageName :: ImageDestination -> Maybe SharedImageName
imageDestinationSharedImageName :: ImageDestination -> Maybe SharedImageName
imageDestinationSharedImageName (Share String
n ImageType
_ ImageResize
_) = SharedImageName -> Maybe SharedImageName
forall a. a -> Maybe a
Just (String -> SharedImageName
SharedImageName String
n)
imageDestinationSharedImageName ImageDestination
_ = Maybe SharedImageName
forall a. Maybe a
Nothing

-- | Return the name of a shared source image, if the 'ImageSource' is a 'From'
--   source
imageSourceSharedImageName :: ImageSource -> Maybe SharedImageName
imageSourceSharedImageName :: ImageSource -> Maybe SharedImageName
imageSourceSharedImageName (From String
n ImageResize
_) = SharedImageName -> Maybe SharedImageName
forall a. a -> Maybe a
Just (String -> SharedImageName
SharedImageName String
n)
imageSourceSharedImageName ImageSource
_ = Maybe SharedImageName
forall a. Maybe a
Nothing

-- | Get the 'ImageDestination' of an 'ImageTarget'
itImageDestination :: ImageTarget -> ImageDestination
itImageDestination :: ImageTarget -> ImageDestination
itImageDestination (ImageTarget ImageDestination
d ImageSource
_ MountPoint
_) = ImageDestination
d

-- | Get the 'ImageSource' of an 'ImageTarget'
itImageSource :: ImageTarget -> ImageSource
itImageSource :: ImageTarget -> ImageSource
itImageSource (ImageTarget ImageDestination
_ ImageSource
s MountPoint
_) = ImageSource
s

-- | Get the 'MountPoint' of an 'ImageTarget'
itImageMountPoint :: ImageTarget -> MountPoint
itImageMountPoint :: ImageTarget -> MountPoint
itImageMountPoint (ImageTarget ImageDestination
_ ImageSource
_ MountPoint
m) = MountPoint
m

-- | Return true if a 'Partition' parameter is actually referring to a partition,
-- false if it is 'NoPT'
isPartitioned :: Partition -> Bool
isPartitioned :: Partition -> Bool
isPartitioned Partition
p
  | Partition
p Partition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
== Partition
NoPT = Bool
False
  | Bool
otherwise = Bool
True

-- | Return the 'Partition' index or throw a runtime error if applied to 'NoPT'
getPartition :: Partition -> Int
getPartition :: Partition -> Int
getPartition (Partition Int
p) = Int
p
getPartition Partition
NoPT = String -> Int
forall a. HasCallStack => String -> a
error String
"No partitions!"

-- | Return the file name extension of an image file with a specific image
-- format.
imageFileExtension :: ImageType -> String
imageFileExtension :: ImageType -> String
imageFileExtension ImageType
Raw = String
"raw"
imageFileExtension ImageType
QCow2 = String
"qcow2"
imageFileExtension ImageType
Vmdk = String
"vmdk"

-- | Change the image file format and also rename the image file name to
-- have the appropriate file name extension. See 'imageFileExtension' and
-- 'replaceExtension'
changeImageFormat :: ImageType -> Image -> Image
changeImageFormat :: ImageType -> Image -> Image
changeImageFormat ImageType
fmt' (Image String
img ImageType
_ FileSystem
fs) = String -> ImageType -> FileSystem -> Image
Image String
img' ImageType
fmt' FileSystem
fs
  where
    img' :: String
img' = String -> ShowS
replaceExtension String
img (ImageType -> String
imageFileExtension ImageType
fmt')

changeImageDirectory :: FilePath -> Image -> Image
changeImageDirectory :: String -> Image -> Image
changeImageDirectory String
dir (Image String
img ImageType
fmt FileSystem
fs) = String -> ImageType -> FileSystem -> Image
Image String
img' ImageType
fmt FileSystem
fs
  where
    img' :: String
img' = String
dir String -> ShowS
</> ShowS
takeFileName String
img

-- * Constructors and accessors for 'ImageSource's

getImageSourceImageType :: ImageSource -> Maybe ImageType
getImageSourceImageType :: ImageSource -> Maybe ImageType
getImageSourceImageType (EmptyImage String
_ FileSystem
_ ImageType
t ImageSize
_) = ImageType -> Maybe ImageType
forall a. a -> Maybe a
Just ImageType
t
getImageSourceImageType (CopyOnWrite Image
i) = ImageType -> Maybe ImageType
forall a. a -> Maybe a
Just (ImageType -> Maybe ImageType) -> ImageType -> Maybe ImageType
forall a b. (a -> b) -> a -> b
$ Image -> ImageType
imageImageType Image
i
getImageSourceImageType (SourceImage Image
i Partition
_ ImageResize
_) = ImageType -> Maybe ImageType
forall a. a -> Maybe a
Just (ImageType -> Maybe ImageType) -> ImageType -> Maybe ImageType
forall a b. (a -> b) -> a -> b
$ Image -> ImageType
imageImageType Image
i
getImageSourceImageType (From String
_ ImageResize
_) = Maybe ImageType
forall a. Maybe a
Nothing

-- * Constructors and accessors for 'SharedImage's

-- | Return the name of a shared image.
sharedImageName :: SharedImage -> SharedImageName
sharedImageName :: SharedImage -> SharedImageName
sharedImageName (SharedImage SharedImageName
n SharedImageDate
_ SharedImageBuildId
_ ImageType
_ FileSystem
_) = SharedImageName
n

-- | Return the build date of a shared image.
sharedImageDate :: SharedImage -> SharedImageDate
sharedImageDate :: SharedImage -> SharedImageDate
sharedImageDate (SharedImage SharedImageName
_ SharedImageDate
n SharedImageBuildId
_ ImageType
_ FileSystem
_) = SharedImageDate
n

-- | Return the build id of a shared image.
sharedImageBuildId :: SharedImage -> SharedImageBuildId
sharedImageBuildId :: SharedImage -> SharedImageBuildId
sharedImageBuildId (SharedImage SharedImageName
_ SharedImageDate
_ SharedImageBuildId
n ImageType
_ FileSystem
_) = SharedImageBuildId
n

-- | Print the contents of the shared image in one line
prettyPrintSharedImages :: Set SharedImage -> String
prettyPrintSharedImages :: Set SharedImage -> String
prettyPrintSharedImages Set SharedImage
imgs = Box -> String
Boxes.render Box
table
  where
    table :: Box
table = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Boxes.hsep Int
1 Alignment
Boxes.left [Box]
cols
      where
        cols :: [Box]
cols = [Box
nameC, Box
dateC, Box
idC]
          where
            nameC :: Box
nameC = String -> (SharedImage -> String) -> Box
col String
"Name" ((\(SharedImageName String
n) -> String
n) (SharedImageName -> String)
-> (SharedImage -> SharedImageName) -> SharedImage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImage -> SharedImageName
sharedImageName)
            dateC :: Box
dateC = String -> (SharedImage -> String) -> Box
col String
"Date" ((\(SharedImageDate String
n) -> String
n) (SharedImageDate -> String)
-> (SharedImage -> SharedImageDate) -> SharedImage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImage -> SharedImageDate
sharedImageDate)
            idC :: Box
idC =
              String -> (SharedImage -> String) -> Box
col
                String
"ID"
                ((\(SharedImageBuildId String
n) -> String
n) (SharedImageBuildId -> String)
-> (SharedImage -> SharedImageBuildId) -> SharedImage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImage -> SharedImageBuildId
sharedImageBuildId)
            col :: String -> (SharedImage -> String) -> Box
col String
title SharedImage -> String
accessor =
              String -> Box
Boxes.text String
title Box -> Box -> Box
Boxes.// Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.left [Box]
cells
              where
                cells :: [Box]
cells = String -> Box
Boxes.text (String -> Box) -> (SharedImage -> String) -> SharedImage -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImage -> String
accessor (SharedImage -> Box) -> [SharedImage] -> [Box]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set SharedImage -> [SharedImage]
forall a. Set a -> [a]
Set.toList Set SharedImage
imgs

-- | Return the disk image of an sharedImage
sharedImageImage :: SharedImage -> Image
sharedImageImage :: SharedImage -> Image
sharedImageImage (SharedImage (SharedImageName String
n) SharedImageDate
_ (SharedImageBuildId String
bid) ImageType
sharedImageType FileSystem
sharedImageFileSystem) =
  String -> ImageType -> FileSystem -> Image
Image
    (String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bid String -> ShowS
<.> ImageType -> String
imageFileExtension ImageType
sharedImageType)
    ImageType
sharedImageType
    FileSystem
sharedImageFileSystem

-- | Calculate the path to the text file holding the serialized 'SharedImage'
-- relative to the directory of shared images in a repository.
sharedImageFileName :: SharedImage -> FilePath
sharedImageFileName :: SharedImage -> String
sharedImageFileName (SharedImage (SharedImageName String
n) SharedImageDate
_ (SharedImageBuildId String
bid) ImageType
_ FileSystem
_) =
  String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bid String -> ShowS
<.> String
sharedImageFileExtension

sharedImagesRootDirectory :: FilePath
sharedImagesRootDirectory :: String
sharedImagesRootDirectory = String
"b9_shared_images"

sharedImageFileExtension :: String
sharedImageFileExtension :: String
sharedImageFileExtension = String
"b9si"

-- | The internal image type to use as best guess when dealing with a 'From'
-- value.
sharedImageDefaultImageType :: ImageType
sharedImageDefaultImageType :: ImageType
sharedImageDefaultImageType = ImageType
QCow2

-- * Constructors for 'ImageTarget's

-- | Use a 'QCow2' image with an 'Ext4' file system
transientCOWImage :: FilePath -> FilePath -> ImageTarget
transientCOWImage :: String -> String -> ImageTarget
transientCOWImage String
fileName String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    ImageDestination
Transient
    (Image -> ImageSource
CopyOnWrite (String -> ImageType -> FileSystem -> Image
Image String
fileName ImageType
QCow2 FileSystem
Ext4))
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Use a shared image
transientSharedImage :: SharedImageName -> FilePath -> ImageTarget
transientSharedImage :: SharedImageName -> String -> ImageTarget
transientSharedImage (SharedImageName String
name) String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget ImageDestination
Transient (String -> ImageResize -> ImageSource
From String
name ImageResize
KeepSize) (String -> MountPoint
MountPoint String
mountPoint)

-- | Use a shared image
transientLocalImage :: FilePath -> FilePath -> ImageTarget
transientLocalImage :: String -> String -> ImageTarget
transientLocalImage String
name String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget ImageDestination
Transient (String -> ImageResize -> ImageSource
From String
name ImageResize
KeepSize) (String -> MountPoint
MountPoint String
mountPoint)

-- | Share a 'QCow2' image with 'Ext4' fs
shareCOWImage :: FilePath -> SharedImageName -> FilePath -> ImageTarget
shareCOWImage :: String -> SharedImageName -> String -> ImageTarget
shareCOWImage String
srcFilename (SharedImageName String
destName) String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (String -> ImageType -> ImageResize -> ImageDestination
Share String
destName ImageType
QCow2 ImageResize
KeepSize)
    (Image -> ImageSource
CopyOnWrite (String -> ImageType -> FileSystem -> Image
Image String
srcFilename ImageType
QCow2 FileSystem
Ext4))
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Share an image based on a shared image
shareSharedImage ::
  SharedImageName -> SharedImageName -> FilePath -> ImageTarget
shareSharedImage :: SharedImageName -> SharedImageName -> String -> ImageTarget
shareSharedImage (SharedImageName String
srcName) (SharedImageName String
destName) String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (String -> ImageType -> ImageResize -> ImageDestination
Share String
destName ImageType
QCow2 ImageResize
KeepSize)
    (String -> ImageResize -> ImageSource
From String
srcName ImageResize
KeepSize)
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Share a 'QCow2' image with 'Ext4' fs
shareLocalImage :: FilePath -> SharedImageName -> FilePath -> ImageTarget
shareLocalImage :: String -> SharedImageName -> String -> ImageTarget
shareLocalImage String
srcName (SharedImageName String
destName) String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (String -> ImageType -> ImageResize -> ImageDestination
Share String
destName ImageType
QCow2 ImageResize
KeepSize)
    (Image -> Partition -> ImageResize -> ImageSource
SourceImage (String -> ImageType -> FileSystem -> Image
Image String
srcName ImageType
QCow2 FileSystem
Ext4) Partition
NoPT ImageResize
KeepSize)
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Export a 'QCow2' image with 'Ext4' fs
cowToliveInstallerImage ::
  String -> FilePath -> FilePath -> FilePath -> ImageTarget
cowToliveInstallerImage :: String -> String -> String -> String -> ImageTarget
cowToliveInstallerImage String
srcName String
destName String
outDir String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (String -> String -> ImageResize -> ImageDestination
LiveInstallerImage String
destName String
outDir ImageResize
KeepSize)
    (Image -> ImageSource
CopyOnWrite (String -> ImageType -> FileSystem -> Image
Image String
srcName ImageType
QCow2 FileSystem
Ext4))
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Export a 'QCow2' image file with 'Ext4' fs as
--   a local file
cowToLocalImage :: FilePath -> FilePath -> FilePath -> ImageTarget
cowToLocalImage :: String -> String -> String -> ImageTarget
cowToLocalImage String
srcName String
destName String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (Image -> ImageResize -> ImageDestination
LocalFile (String -> ImageType -> FileSystem -> Image
Image String
destName ImageType
QCow2 FileSystem
Ext4) ImageResize
KeepSize)
    (Image -> ImageSource
CopyOnWrite (String -> ImageType -> FileSystem -> Image
Image String
srcName ImageType
QCow2 FileSystem
Ext4))
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Export a 'QCow2' image file with 'Ext4' fs as
--   a local file
localToLocalImage :: FilePath -> FilePath -> FilePath -> ImageTarget
localToLocalImage :: String -> String -> String -> ImageTarget
localToLocalImage String
srcName String
destName String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (Image -> ImageResize -> ImageDestination
LocalFile (String -> ImageType -> FileSystem -> Image
Image String
destName ImageType
QCow2 FileSystem
Ext4) ImageResize
KeepSize)
    (Image -> Partition -> ImageResize -> ImageSource
SourceImage (String -> ImageType -> FileSystem -> Image
Image String
srcName ImageType
QCow2 FileSystem
Ext4) Partition
NoPT ImageResize
KeepSize)
    (String -> MountPoint
MountPoint String
mountPoint)

-- | Create a local image file from the contents of the first partition
--   of a local 'QCow2' image.
partition1ToLocalImage :: FilePath -> FilePath -> FilePath -> ImageTarget
partition1ToLocalImage :: String -> String -> String -> ImageTarget
partition1ToLocalImage String
srcName String
destName String
mountPoint =
  ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
    (Image -> ImageResize -> ImageDestination
LocalFile (String -> ImageType -> FileSystem -> Image
Image String
destName ImageType
QCow2 FileSystem
Ext4) ImageResize
KeepSize)
    (Image -> Partition -> ImageResize -> ImageSource
SourceImage (String -> ImageType -> FileSystem -> Image
Image String
srcName ImageType
QCow2 FileSystem
Ext4) Partition
NoPT ImageResize
KeepSize)
    (String -> MountPoint
MountPoint String
mountPoint)

-- * 'ImageTarget' Transformations

-- | Split any image target into two image targets, one for creating an intermediate shared image and one
-- from the intermediate shared image to the output image.
splitToIntermediateSharedImage ::
  ImageTarget -> SharedImageName -> (ImageTarget, ImageTarget)
splitToIntermediateSharedImage :: ImageTarget -> SharedImageName -> (ImageTarget, ImageTarget)
splitToIntermediateSharedImage (ImageTarget ImageDestination
dst ImageSource
src MountPoint
mnt) (SharedImageName String
intermediateName) =
  (ImageTarget
imgTargetShared, ImageTarget
imgTargetExport)
  where
    imgTargetShared :: ImageTarget
imgTargetShared = ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget ImageDestination
intermediateTo ImageSource
src MountPoint
mnt
    imgTargetExport :: ImageTarget
imgTargetExport = ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget ImageDestination
dst ImageSource
intermediateFrom MountPoint
mnt
    intermediateTo :: ImageDestination
intermediateTo =
      String -> ImageType -> ImageResize -> ImageDestination
Share
        String
intermediateName
        (ImageType -> Maybe ImageType -> ImageType
forall a. a -> Maybe a -> a
fromMaybe ImageType
sharedImageDefaultImageType (ImageSource -> Maybe ImageType
getImageSourceImageType ImageSource
src))
        ImageResize
KeepSize
    intermediateFrom :: ImageSource
intermediateFrom = String -> ImageResize -> ImageSource
From String
intermediateName ImageResize
KeepSize

-- * 'Arbitrary' instances for quickcheck

instance Arbitrary ImageTarget where
  arbitrary :: Gen ImageTarget
arbitrary =
    ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget
      (ImageDestination -> ImageSource -> MountPoint -> ImageTarget)
-> Gen ImageDestination
-> Gen (ImageSource -> MountPoint -> ImageTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ImageDestination -> Gen ImageDestination
forall a. Gen a -> Gen a
smaller Gen ImageDestination
forall a. Arbitrary a => Gen a
arbitrary
      Gen (ImageSource -> MountPoint -> ImageTarget)
-> Gen ImageSource -> Gen (MountPoint -> ImageTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageSource -> Gen ImageSource
forall a. Gen a -> Gen a
smaller Gen ImageSource
forall a. Arbitrary a => Gen a
arbitrary
      Gen (MountPoint -> ImageTarget)
-> Gen MountPoint -> Gen ImageTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen MountPoint -> Gen MountPoint
forall a. Gen a -> Gen a
smaller Gen MountPoint
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ImageSource where
  arbitrary :: Gen ImageSource
arbitrary =
    [Gen ImageSource] -> Gen ImageSource
forall a. [Gen a] -> Gen a
oneof
      [ String -> FileSystem -> ImageType -> ImageSize -> ImageSource
EmptyImage (String -> FileSystem -> ImageType -> ImageSize -> ImageSource)
-> (Int -> String)
-> Int
-> FileSystem
-> ImageType
-> ImageSize
-> ImageSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"img-label-%0X"
          (Int -> FileSystem -> ImageType -> ImageSize -> ImageSource)
-> Gen Int
-> Gen (FileSystem -> ImageType -> ImageSize -> ImageSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
63 :: Int)
          Gen (FileSystem -> ImageType -> ImageSize -> ImageSource)
-> Gen FileSystem -> Gen (ImageType -> ImageSize -> ImageSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FileSystem -> Gen FileSystem
forall a. Gen a -> Gen a
smaller Gen FileSystem
forall a. Arbitrary a => Gen a
arbitrary
          Gen (ImageType -> ImageSize -> ImageSource)
-> Gen ImageType -> Gen (ImageSize -> ImageSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageType -> Gen ImageType
forall a. Gen a -> Gen a
smaller Gen ImageType
forall a. Arbitrary a => Gen a
arbitrary
          Gen (ImageSize -> ImageSource) -> Gen ImageSize -> Gen ImageSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageSize -> Gen ImageSize
forall a. Gen a -> Gen a
smaller Gen ImageSize
forall a. Arbitrary a => Gen a
arbitrary,
        Image -> ImageSource
CopyOnWrite (Image -> ImageSource) -> Gen Image -> Gen ImageSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Image -> Gen Image
forall a. Gen a -> Gen a
smaller Gen Image
forall a. Arbitrary a => Gen a
arbitrary,
        Image -> Partition -> ImageResize -> ImageSource
SourceImage
          (Image -> Partition -> ImageResize -> ImageSource)
-> Gen Image -> Gen (Partition -> ImageResize -> ImageSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Image -> Gen Image
forall a. Gen a -> Gen a
smaller Gen Image
forall a. Arbitrary a => Gen a
arbitrary
          Gen (Partition -> ImageResize -> ImageSource)
-> Gen Partition -> Gen (ImageResize -> ImageSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Partition -> Gen Partition
forall a. Gen a -> Gen a
smaller Gen Partition
forall a. Arbitrary a => Gen a
arbitrary
          Gen (ImageResize -> ImageSource)
-> Gen ImageResize -> Gen ImageSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageResize -> Gen ImageResize
forall a. Gen a -> Gen a
smaller Gen ImageResize
forall a. Arbitrary a => Gen a
arbitrary,
        String -> ImageResize -> ImageSource
From (String -> ImageResize -> ImageSource)
-> Gen String -> Gen (ImageResize -> ImageSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitrarySharedImageName Gen (ImageResize -> ImageSource)
-> Gen ImageResize -> Gen ImageSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageResize -> Gen ImageResize
forall a. Gen a -> Gen a
smaller Gen ImageResize
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary ImageDestination where
  arbitrary :: Gen ImageDestination
arbitrary =
    [Gen ImageDestination] -> Gen ImageDestination
forall a. [Gen a] -> Gen a
oneof
      [ String -> ImageType -> ImageResize -> ImageDestination
Share
          (String -> ImageType -> ImageResize -> ImageDestination)
-> Gen String -> Gen (ImageType -> ImageResize -> ImageDestination)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitrarySharedImageName
          Gen (ImageType -> ImageResize -> ImageDestination)
-> Gen ImageType -> Gen (ImageResize -> ImageDestination)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageType -> Gen ImageType
forall a. Gen a -> Gen a
smaller Gen ImageType
forall a. Arbitrary a => Gen a
arbitrary
          Gen (ImageResize -> ImageDestination)
-> Gen ImageResize -> Gen ImageDestination
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageResize -> Gen ImageResize
forall a. Gen a -> Gen a
smaller Gen ImageResize
forall a. Arbitrary a => Gen a
arbitrary,
        String -> String -> ImageResize -> ImageDestination
LiveInstallerImage String
"live-installer" String
"output-path"
          (ImageResize -> ImageDestination)
-> Gen ImageResize -> Gen ImageDestination
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ImageResize -> Gen ImageResize
forall a. Gen a -> Gen a
smaller Gen ImageResize
forall a. Arbitrary a => Gen a
arbitrary,
        ImageDestination -> Gen ImageDestination
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageDestination
Transient
      ]

instance Arbitrary MountPoint where
  arbitrary :: Gen MountPoint
arbitrary = [MountPoint] -> Gen MountPoint
forall a. [a] -> Gen a
elements [String -> MountPoint
MountPoint String
"/mnt", MountPoint
NotMounted]

instance Arbitrary ImageResize where
  arbitrary :: Gen ImageResize
arbitrary =
    [Gen ImageResize] -> Gen ImageResize
forall a. [Gen a] -> Gen a
oneof
      [ ImageSize -> ImageResize
ResizeImage (ImageSize -> ImageResize) -> Gen ImageSize -> Gen ImageResize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ImageSize -> Gen ImageSize
forall a. Gen a -> Gen a
smaller Gen ImageSize
forall a. Arbitrary a => Gen a
arbitrary,
        ImageSize -> ImageResize
Resize (ImageSize -> ImageResize) -> Gen ImageSize -> Gen ImageResize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ImageSize -> Gen ImageSize
forall a. Gen a -> Gen a
smaller Gen ImageSize
forall a. Arbitrary a => Gen a
arbitrary,
        ImageSize -> ImageResize
ShrinkToMinimumAndIncrease (ImageSize -> ImageResize) -> Gen ImageSize -> Gen ImageResize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ImageSize -> Gen ImageSize
forall a. Gen a -> Gen a
smaller Gen ImageSize
forall a. Arbitrary a => Gen a
arbitrary,
        ImageResize -> Gen ImageResize
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageResize
ShrinkToMinimum,
        ImageResize -> Gen ImageResize
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageResize
KeepSize
      ]

instance Arbitrary Partition where
  arbitrary :: Gen Partition
arbitrary = [Gen Partition] -> Gen Partition
forall a. [Gen a] -> Gen a
oneof [Int -> Partition
Partition (Int -> Partition) -> Gen Int -> Gen Partition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
2), Partition -> Gen Partition
forall (f :: * -> *) a. Applicative f => a -> f a
pure Partition
NoPT]

instance Arbitrary Image where
  arbitrary :: Gen Image
arbitrary =
    String -> ImageType -> FileSystem -> Image
Image (String -> ImageType -> FileSystem -> Image)
-> (Int -> String) -> Int -> ImageType -> FileSystem -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"img-file-name-%0X"
      (Int -> ImageType -> FileSystem -> Image)
-> Gen Int -> Gen (ImageType -> FileSystem -> Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
63 :: Int)
      Gen (ImageType -> FileSystem -> Image)
-> Gen ImageType -> Gen (FileSystem -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ImageType -> Gen ImageType
forall a. Gen a -> Gen a
smaller Gen ImageType
forall a. Arbitrary a => Gen a
arbitrary
      Gen (FileSystem -> Image) -> Gen FileSystem -> Gen Image
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FileSystem -> Gen FileSystem
forall a. Gen a -> Gen a
smaller Gen FileSystem
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary FileSystem where
  arbitrary :: Gen FileSystem
arbitrary = [FileSystem] -> Gen FileSystem
forall a. [a] -> Gen a
elements [FileSystem
Ext4]

instance Arbitrary ImageType where
  arbitrary :: Gen ImageType
arbitrary = [ImageType] -> Gen ImageType
forall a. [a] -> Gen a
elements [ImageType
Raw, ImageType
QCow2, ImageType
Vmdk]

instance Arbitrary ImageSize where
  arbitrary :: Gen ImageSize
arbitrary = Int -> SizeUnit -> ImageSize
ImageSize (Int -> SizeUnit -> ImageSize)
-> Gen Int -> Gen (SizeUnit -> ImageSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int -> Gen Int
forall a. Gen a -> Gen a
smaller Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen (SizeUnit -> ImageSize) -> Gen SizeUnit -> Gen ImageSize
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SizeUnit -> Gen SizeUnit
forall a. Gen a -> Gen a
smaller Gen SizeUnit
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary SizeUnit where
  arbitrary :: Gen SizeUnit
arbitrary = [SizeUnit] -> Gen SizeUnit
forall a. [a] -> Gen a
elements [SizeUnit
KB, SizeUnit
MB, SizeUnit
GB]

instance Arbitrary SharedImageName where
  arbitrary :: Gen SharedImageName
arbitrary = String -> SharedImageName
SharedImageName (String -> SharedImageName) -> Gen String -> Gen SharedImageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitrarySharedImageName

instance Function SharedImageName where
  function :: (SharedImageName -> b) -> SharedImageName :-> b
function = (SharedImageName -> b) -> SharedImageName :-> b
forall a c. (Show a, Read a) => (a -> c) -> a :-> c
functionShow

arbitrarySharedImageName :: Gen String
arbitrarySharedImageName :: Gen String
arbitrarySharedImageName =
  String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"shared-img-%0X" (Int -> String) -> Gen Int -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
63 :: Int)

instance Arbitrary SharedImageBuildId where
  arbitrary :: Gen SharedImageBuildId
arbitrary = do
    String -> SharedImageBuildId
SharedImageBuildId (String -> SharedImageBuildId)
-> (Int -> String) -> Int -> SharedImageBuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"shared-img-build-id-%0X" (Int -> SharedImageBuildId) -> Gen Int -> Gen SharedImageBuildId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024 :: Int)

instance Function SharedImageBuildId where
  function :: (SharedImageBuildId -> b) -> SharedImageBuildId :-> b
function = (SharedImageBuildId -> String)
-> (String -> SharedImageBuildId)
-> (SharedImageBuildId -> b)
-> SharedImageBuildId :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap SharedImageBuildId -> String
fromSharedImageBuildId String -> SharedImageBuildId
SharedImageBuildId

instance Function SharedImageDate where
  function :: (SharedImageDate -> b) -> SharedImageDate :-> b
function =
    (SharedImageDate -> (Integer, Integer))
-> ((Integer, Integer) -> SharedImageDate)
-> (SharedImageDate -> b)
-> SharedImageDate :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap
      ( ( \(UTCTime (ModifiedJulianDay Integer
d) DiffTime
dt) ->
            (Integer
d, DiffTime -> Integer
diffTimeToPicoseconds DiffTime
dt Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000000000)
        )
          (UTCTime -> (Integer, Integer))
-> (SharedImageDate -> UTCTime)
-> SharedImageDate
-> (Integer, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
"%F-%T"
          (String -> UTCTime)
-> (SharedImageDate -> String) -> SharedImageDate -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(SharedImageDate String
d) -> String
d)
      )
      ( String -> SharedImageDate
SharedImageDate
          (String -> SharedImageDate)
-> ((Integer, Integer) -> String)
-> (Integer, Integer)
-> SharedImageDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F-%T")
          (UTCTime -> String)
-> ((Integer, Integer) -> UTCTime) -> (Integer, Integer) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Integer
d, Integer
dt) -> Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
d) (Integer -> DiffTime
secondsToDiffTime Integer
dt))
      )

instance Arbitrary SharedImageDate where
  arbitrary :: Gen SharedImageDate
arbitrary =
    String -> SharedImageDate
SharedImageDate
      (String -> SharedImageDate)
-> ((Integer, Integer) -> String)
-> (Integer, Integer)
-> SharedImageDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F-%T")
      (UTCTime -> String)
-> ((Integer, Integer) -> UTCTime) -> (Integer, Integer) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Integer
d, Integer
dt) -> Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
d) (Integer -> DiffTime
secondsToDiffTime Integer
dt))
      ((Integer, Integer) -> SharedImageDate)
-> Gen (Integer, Integer) -> Gen SharedImageDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Integer, Integer)
forall a. Arbitrary a => Gen a
arbitrary

unitTests :: Spec
unitTests :: Spec
unitTests =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ImageSize"
    (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"bytesToKiloBytes"
    (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"accepts maxBound" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
        Int -> Integer
forall a. Integral a => a -> Integer
toInteger (ImageSize -> Int
imageSizeToKiB (Int -> ImageSize
bytesToKiloBytes Int
forall a. Bounded a => a
maxBound)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1024 Integer -> Integer -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
      String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"doesn't decrease in size" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
        (Int -> Property) -> Property
forall prop. Testable prop => prop -> Property
property
          ( \(Int
x :: Int) ->
              Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1024 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
label String
"bytesToKiloBytes x >= x" (ImageSize -> Int
imageSizeToKiB (Int -> ImageSize
bytesToKiloBytes Int
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024))
          )