    {-# LANGUAGE FlexibleContexts #-}

    module Propellor.Property.Parted (
    	-- * Types
    	TableType(..),
    	PartTable(..),
    	partTableSize,
    	Partition(..),
    	mkPartition,
    	Partition.Fs(..),
    	PartSize(..),
    	ByteSize,
    	toPartSize,
    	fromPartSize,
    	reducePartSize,
    	Alignment(..),
    	safeAlignment,
    	Partition.MkfsOpts,
    	PartType(..),
    	PartFlag(..),
    	-- * Properties
    	partitioned,
    	parted,
    	Eep(..),
    	installed,
    	-- * Partition table sizing
    	calcPartTable,
    	DiskSize(..),
    	DiskPart,
    	DiskSpaceUse(..),
    	useDiskSpace,
    	defSz,
    	fudgeSz,
    ) where

    import Propellor.Base
    import Propellor.Property.Parted.Types
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.Pacman as Pacman
    import qualified Propellor.Property.Partition as Partition
    import Propellor.Types.PartSpec (PartSpec)
    import Utility.DataUnits

    import System.Posix.Files
    import qualified Data.Semigroup as Sem
    import Data.List (genericLength)

    data Eep = YesReallyDeleteDiskContents

    -- | Partitions a disk using parted, and formats the partitions.
    --
    -- The FilePath can be a block device (eg, \/dev\/sda), or a disk image file.
    --
    -- This deletes any existing partitions in the disk! Use with EXTREME caution!
    partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
    partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
    partitioned eep :: Eep
    eep disk :: FilePath
    disk parttable :: PartTable
    parttable@(PartTable _ _ parts :: [Partition]
    parts) = FilePath
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall k (metatypes :: k).
    SingI metatypes =>
    FilePath
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' FilePath
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property DebianLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ \w :: OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    	Bool
    isdev <- IO Bool -> Propellor Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ FileStatus -> Bool
    isBlockDevice (FileStatus -> Bool) -> IO FileStatus -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO FileStatus
    getFileStatus FilePath
    disk
    	OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property DebianLike -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property DebianLike -> Propellor Result)
    -> Property DebianLike -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Props DebianLike -> Property DebianLike
    forall k (metatypes :: k).
    SingI metatypes =>
    FilePath
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    combineProperties FilePath
    desc (Props DebianLike -> Property DebianLike)
    -> Props DebianLike -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ Props UnixLike
    props
    		Props UnixLike
    -> Property
         (Sing
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall a p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & Eep -> FilePath -> [FilePath] -> Property (DebianLike + ArchLinux)
    parted Eep
    eep FilePath
    disk (([FilePath], ByteSize) -> [FilePath]
    forall a b. (a, b) -> a
    fst (PartTable -> ([FilePath], ByteSize)
    calcPartedParamsSize PartTable
    parttable))
    		Props
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    -> Property DebianLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    forall a p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & if Bool
    isdev
    			then [FilePath] -> Property DebianLike
    formatl ((Int -> FilePath) -> [Int] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (\n :: Int
    n -> FilePath
    disk FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n) [1 :: Int ..])
    			else FilePath
    -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
    Partition.kpartx FilePath
    disk ([FilePath] -> Property DebianLike
    formatl ([FilePath] -> Property DebianLike)
    -> ([LoopDev] -> [FilePath]) -> [LoopDev] -> Property DebianLike
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LoopDev -> FilePath) -> [LoopDev] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map LoopDev -> FilePath
    Partition.partitionLoopDev)
      where
    	desc :: FilePath
    desc = FilePath
    disk FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " partitioned"
    	formatl :: [FilePath] -> Property DebianLike
    formatl devs :: [FilePath]
    devs = FilePath -> Props DebianLike -> Property DebianLike
    forall k (metatypes :: k).
    SingI metatypes =>
    FilePath
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    combineProperties FilePath
    desc ([Property DebianLike] -> Props DebianLike
    forall k (metatypes :: k).
    [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
    toProps ([Property DebianLike] -> Props DebianLike)
    -> [Property DebianLike] -> Props DebianLike
    forall a b. (a -> b) -> a -> b
    $ ((Partition, FilePath) -> Property DebianLike)
    -> [(Partition, FilePath)] -> [Property DebianLike]
    forall a b. (a -> b) -> [a] -> [b]
    map (Partition, FilePath) -> Property DebianLike
    format ([Partition] -> [FilePath] -> [(Partition, FilePath)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Partition]
    parts [FilePath]
    devs))
    	format :: (Partition, FilePath) -> Property DebianLike
    format (p :: Partition
    p, dev :: FilePath
    dev) = case Partition -> Maybe Fs
    partFs Partition
    p of
    		Just fs :: Fs
    fs -> [FilePath] -> Eep -> Fs -> FilePath -> Property DebianLike
    Partition.formatted' (Partition -> [FilePath]
    partMkFsOpts Partition
    p)
    			Eep
    Partition.YesReallyFormatPartition Fs
    fs FilePath
    dev
    		Nothing -> Property DebianLike
    forall k (t :: k). SingI t => Property (MetaTypes t)
    doNothing

    -- | Gets the total size of the disk specified by the partition table.
    partTableSize :: PartTable -> ByteSize
    partTableSize :: PartTable -> ByteSize
    partTableSize = ([FilePath], ByteSize) -> ByteSize
    forall a b. (a, b) -> b
    snd (([FilePath], ByteSize) -> ByteSize)
    -> (PartTable -> ([FilePath], ByteSize)) -> PartTable -> ByteSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PartTable -> ([FilePath], ByteSize)
    calcPartedParamsSize

    calcPartedParamsSize :: PartTable -> ([String], ByteSize)
    calcPartedParamsSize :: PartTable -> ([FilePath], ByteSize)
    calcPartedParamsSize (PartTable tabletype :: TableType
    tabletype alignment :: Alignment
    alignment parts :: [Partition]
    parts) =
    	let (ps :: [[FilePath]]
    ps, sz :: ByteSize
    sz) = ByteSize
    -> ByteSize
    -> [Partition]
    -> [[FilePath]]
    -> ([[FilePath]], ByteSize)
    forall a.
    (Num a, Show a) =>
    a
    -> ByteSize
    -> [Partition]
    -> [[FilePath]]
    -> ([[FilePath]], ByteSize)
    calcparts (1 :: Integer) ByteSize
    firstpos [Partition]
    parts []
    	in ([[FilePath]] -> [FilePath]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([FilePath]
    mklabel [FilePath] -> [[FilePath]] -> [[FilePath]]
    forall a. a -> [a] -> [a]
    : [[FilePath]]
    ps), ByteSize
    sz)
      where
    	mklabel :: [FilePath]
    mklabel = ["mklabel", TableType -> FilePath
    forall a. PartedVal a => a -> FilePath
    pval TableType
    tabletype]
    	mkflag :: a -> (a, a) -> [FilePath]
    mkflag partnum :: a
    partnum (f :: a
    f, b :: a
    b) =
    		[ "set"
    		, a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    partnum
    		, a -> FilePath
    forall a. PartedVal a => a -> FilePath
    pval a
    f
    		, a -> FilePath
    forall a. PartedVal a => a -> FilePath
    pval a
    b
    		]
    	mkpart :: a -> a -> a -> Partition -> [FilePath]
    mkpart partnum :: a
    partnum startpos :: a
    startpos endpos :: a
    endpos p :: Partition
    p = [Maybe FilePath] -> [FilePath]
    forall a. [Maybe a] -> [a]
    catMaybes
    		[ FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "mkpart"
    		, FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ PartType -> FilePath
    forall a. PartedVal a => a -> FilePath
    pval (Partition -> PartType
    partType Partition
    p)
    		, (Fs -> FilePath) -> Maybe Fs -> Maybe FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Fs -> FilePath
    forall a. PartedVal a => a -> FilePath
    pval (Partition -> Maybe Fs
    partFs Partition
    p)
    		, FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ a -> FilePath
    forall a. (Ord a, Num a, Show a) => a -> FilePath
    partposexact a
    startpos
    		, FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ a -> FilePath
    forall a. Integral a => a -> FilePath
    partposfuzzy a
    endpos
    		] [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ case Partition -> Maybe FilePath
    partName Partition
    p of
    			Just n :: FilePath
    n -> ["name", a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    partnum, FilePath
    n]
    			Nothing -> []
    	calcparts :: a
    -> ByteSize
    -> [Partition]
    -> [[FilePath]]
    -> ([[FilePath]], ByteSize)
    calcparts partnum :: a
    partnum startpos :: ByteSize
    startpos (p :: Partition
    p:ps :: [Partition]
    ps) c :: [[FilePath]]
    c =
    		let endpos :: ByteSize
    endpos = ByteSize
    startpos ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    + PartSize -> ByteSize
    align (Partition -> PartSize
    partSize Partition
    p)
    		in a
    -> ByteSize
    -> [Partition]
    -> [[FilePath]]
    -> ([[FilePath]], ByteSize)
    calcparts (a
    partnuma -> a -> a
    forall a. Num a => a -> a -> a
    +1) ByteSize
    endpos [Partition]
    ps
    			([[FilePath]]
    c [[FilePath]] -> [[FilePath]] -> [[FilePath]]
    forall a. [a] -> [a] -> [a]
    ++ a -> ByteSize -> ByteSize -> Partition -> [FilePath]
    forall a a a.
    (Integral a, Show a, Show a, Num a, Ord a) =>
    a -> a -> a -> Partition -> [FilePath]
    mkpart a
    partnum ByteSize
    startpos (ByteSize
    endposByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    -1) Partition
    p [FilePath] -> [[FilePath]] -> [[FilePath]]
    forall a. a -> [a] -> [a]
    : ((PartFlag, Bool) -> [FilePath])
    -> [(PartFlag, Bool)] -> [[FilePath]]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> (PartFlag, Bool) -> [FilePath]
    forall a a a.
    (Show a, PartedVal a, PartedVal a) =>
    a -> (a, a) -> [FilePath]
    mkflag a
    partnum) (Partition -> [(PartFlag, Bool)]
    partFlags Partition
    p))
    	calcparts _ endpos :: ByteSize
    endpos [] c :: [[FilePath]]
    c = ([[FilePath]]
    c, ByteSize
    endpos)

    	-- Exact partition position value for parted.
    	-- For alignment to work, the start of a partition must be
    	-- specified exactly.
    	partposexact :: a -> FilePath
    partposexact n :: a
    n
    		| a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 = a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ "B"
    		-- parted can't make partitions smaller than 1MB;
    		-- avoid failure in edge cases
    		| Bool
    otherwise = "1MB"

    	-- Fuzzy partition position valie for parted.
    	-- This is used to specify the end of the partition,
    	-- parted takes the "MB" as license to slightly reduce the
    	-- partition size when something about the partition table
    	-- does not allow the partition to end exactly at the position.
    	partposfuzzy :: a -> FilePath
    partposfuzzy n :: a
    n
    		| a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 = Double -> FilePath
    forall a. Show a => a -> FilePath
    show (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 1000000 :: Double) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ "MB"
    		| Bool
    otherwise = "1MB"

    	-- Location of the start of the first partition,
    	-- leaving space for the partition table, and aligning.
    	firstpos :: ByteSize
    firstpos = PartSize -> ByteSize
    align PartSize
    partitionTableOverhead

    	align :: PartSize -> ByteSize
    align = Alignment -> PartSize -> ByteSize
    alignTo Alignment
    alignment

    -- | Runs parted on a disk with the specified parameters.
    --
    -- Parted is run in script mode, so it will never prompt for input.
    parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux)
    parted :: Eep -> FilePath -> [FilePath] -> Property (DebianLike + ArchLinux)
    parted YesReallyDeleteDiskContents disk :: FilePath
    disk ps :: [FilePath]
    ps = Property UnixLike
    p Property UnixLike
    -> Property
         (Sing
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    -> CombinedType
         (Property UnixLike)
         (Property
            (Sing
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux]))
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property
      (Sing
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux])
    Property (DebianLike + ArchLinux)
    installed
      where
    	p :: Property UnixLike
    p = FilePath -> [FilePath] -> UncheckedProperty UnixLike
    cmdProperty "parted" ("--script"FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :"--align"FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :"none"FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :FilePath
    diskFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    ps)
    		UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange

    -- | Gets parted installed.
    installed :: Property (DebianLike + ArchLinux)
    installed :: Property (DebianLike + ArchLinux)
    installed = [FilePath] -> Property DebianLike
    Apt.installed ["parted"] Property DebianLike
    -> Property ArchLinux
    -> Property
         (Sing
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
    forall k ka kb (c :: k) (a :: ka) (b :: kb).
    (HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
     DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
     SingI c) =>
    Property (MetaTypes a)
    -> Property (MetaTypes b) -> Property (MetaTypes c)
    `pickOS` [FilePath] -> Property ArchLinux
    Pacman.installed ["parted"]

    -- | Some disk is used to store the partition table itself. Assume less
    -- than 1 mb.
    partitionTableOverhead :: PartSize
    partitionTableOverhead :: PartSize
    partitionTableOverhead = ByteSize -> PartSize
    MegaBytes 1

    -- | Calculate a partition table, for a given size of disk.
    --
    -- For example:
    --
    -- >	calcPartTable (DiskSize (1024 * 1024 * 1024 * 100)) MSDOS safeAlignment
    -- > 		[ partition EXT2 `mountedAt` "/boot"
    -- > 			`setSize` MegaBytes 256
    -- > 			`setFlag` BootFlag
    -- >		, partition EXT4 `mountedAt` "/"
    -- >			`useDiskSpace` RemainingSpace
    -- >		]
    calcPartTable :: DiskSize -> TableType -> Alignment -> [PartSpec DiskPart] -> PartTable
    calcPartTable :: DiskSize
    -> TableType -> Alignment -> [PartSpec DiskPart] -> PartTable
    calcPartTable (DiskSize disksize :: ByteSize
    disksize) tt :: TableType
    tt alignment :: Alignment
    alignment l :: [PartSpec DiskPart]
    l =
    	TableType -> Alignment -> [Partition] -> PartTable
    PartTable TableType
    tt Alignment
    alignment ((PartSpec DiskPart -> Partition)
    -> [PartSpec DiskPart] -> [Partition]
    forall a b. (a -> b) -> [a] -> [b]
    map PartSpec DiskPart -> Partition
    go [PartSpec DiskPart]
    l)
      where
    	go :: PartSpec DiskPart -> Partition
    go (_, _, mkpart :: PartSize -> Partition
    mkpart, FixedDiskPart) = PartSize -> Partition
    mkpart PartSize
    defSz
    	go (_, _, mkpart :: PartSize -> Partition
    mkpart, DynamicDiskPart (Percent p :: Int
    p)) = PartSize -> Partition
    mkpart (PartSize -> Partition) -> PartSize -> Partition
    forall a b. (a -> b) -> a -> b
    $ ByteSize -> PartSize
    Bytes (ByteSize -> PartSize) -> ByteSize -> PartSize
    forall a b. (a -> b) -> a -> b
    $
    		ByteSize
    diskremainingafterfixed ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    * Int -> ByteSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    p ByteSize -> ByteSize -> ByteSize
    forall a. Integral a => a -> a -> a
    `div` 100
    	go (_, _, mkpart :: PartSize -> Partition
    mkpart, DynamicDiskPart RemainingSpace) = PartSize -> Partition
    mkpart (PartSize -> Partition) -> PartSize -> Partition
    forall a b. (a -> b) -> a -> b
    $ ByteSize -> PartSize
    Bytes (ByteSize -> PartSize) -> ByteSize -> PartSize
    forall a b. (a -> b) -> a -> b
    $
    		ByteSize
    diskremaining ByteSize -> ByteSize -> ByteSize
    forall a. Integral a => a -> a -> a
    `div` [PartSpec DiskPart] -> ByteSize
    forall i a. Num i => [a] -> i
    genericLength ((PartSpec DiskPart -> Bool)
    -> [PartSpec DiskPart] -> [PartSpec DiskPart]
    forall a. (a -> Bool) -> [a] -> [a]
    filter PartSpec DiskPart -> Bool
    forall a b c. (a, b, c, DiskPart) -> Bool
    isremainingspace [PartSpec DiskPart]
    l)
    	diskremainingafterfixed :: ByteSize
    diskremainingafterfixed =
    		ByteSize
    disksize ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    - [PartSpec DiskPart] -> ByteSize
    sumsizes ((PartSpec DiskPart -> Bool)
    -> [PartSpec DiskPart] -> [PartSpec DiskPart]
    forall a. (a -> Bool) -> [a] -> [a]
    filter PartSpec DiskPart -> Bool
    forall a b c. (a, b, c, DiskPart) -> Bool
    isfixed [PartSpec DiskPart]
    l)
    	diskremaining :: ByteSize
    diskremaining =
    		ByteSize
    disksize ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    - [PartSpec DiskPart] -> ByteSize
    sumsizes ((PartSpec DiskPart -> Bool)
    -> [PartSpec DiskPart] -> [PartSpec DiskPart]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (PartSpec DiskPart -> Bool) -> PartSpec DiskPart -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PartSpec DiskPart -> Bool
    forall a b c. (a, b, c, DiskPart) -> Bool
    isremainingspace) [PartSpec DiskPart]
    l)
    	sumsizes :: [PartSpec DiskPart] -> ByteSize
    sumsizes = PartTable -> ByteSize
    partTableSize (PartTable -> ByteSize)
    -> ([PartSpec DiskPart] -> PartTable)
    -> [PartSpec DiskPart]
    -> ByteSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TableType -> Alignment -> [Partition] -> PartTable
    PartTable TableType
    tt Alignment
    alignment ([Partition] -> PartTable)
    -> ([PartSpec DiskPart] -> [Partition])
    -> [PartSpec DiskPart]
    -> PartTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PartSpec DiskPart -> Partition)
    -> [PartSpec DiskPart] -> [Partition]
    forall a b. (a -> b) -> [a] -> [b]
    map PartSpec DiskPart -> Partition
    go
    	isfixed :: (a, b, c, DiskPart) -> Bool
    isfixed (_, _, _, FixedDiskPart) = Bool
    True
    	isfixed _ = Bool
    False
    	isremainingspace :: (a, b, c, DiskPart) -> Bool
    isremainingspace (_, _, _, DynamicDiskPart RemainingSpace) = Bool
    True
    	isremainingspace _ = Bool
    False

    -- | Size of a disk, in bytes.
    newtype DiskSize = DiskSize ByteSize
    	deriving (Int -> DiskSize -> FilePath -> FilePath
    [DiskSize] -> FilePath -> FilePath
    DiskSize -> FilePath
    (Int -> DiskSize -> FilePath -> FilePath)
    -> (DiskSize -> FilePath)
    -> ([DiskSize] -> FilePath -> FilePath)
    -> Show DiskSize
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    showList :: [DiskSize] -> FilePath -> FilePath
    $cshowList :: [DiskSize] -> FilePath -> FilePath
    show :: DiskSize -> FilePath
    $cshow :: DiskSize -> FilePath
    showsPrec :: Int -> DiskSize -> FilePath -> FilePath
    $cshowsPrec :: Int -> DiskSize -> FilePath -> FilePath
    Show)

    data DiskPart = FixedDiskPart | DynamicDiskPart DiskSpaceUse

    data DiskSpaceUse = Percent Int | RemainingSpace

    instance Sem.Semigroup DiskPart where
    	FixedDiskPart <> :: DiskPart -> DiskPart -> DiskPart
    <> FixedDiskPart = DiskPart
    FixedDiskPart
    	DynamicDiskPart (Percent a :: Int
    a) <> DynamicDiskPart (Percent b :: Int
    b) =
    		DiskSpaceUse -> DiskPart
    DynamicDiskPart (Int -> DiskSpaceUse
    Percent (Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    b))
    	DynamicDiskPart RemainingSpace <> DynamicDiskPart RemainingSpace =
    		DiskSpaceUse -> DiskPart
    DynamicDiskPart DiskSpaceUse
    RemainingSpace
    	DynamicDiskPart (Percent a :: Int
    a) <> _ = DiskSpaceUse -> DiskPart
    DynamicDiskPart (Int -> DiskSpaceUse
    Percent Int
    a)
    	_ <> DynamicDiskPart (Percent b :: Int
    b) = DiskSpaceUse -> DiskPart
    DynamicDiskPart (Int -> DiskSpaceUse
    Percent Int
    b)
    	DynamicDiskPart RemainingSpace <> _ = DiskSpaceUse -> DiskPart
    DynamicDiskPart DiskSpaceUse
    RemainingSpace
    	_ <> DynamicDiskPart RemainingSpace = DiskSpaceUse -> DiskPart
    DynamicDiskPart DiskSpaceUse
    RemainingSpace

    instance Monoid DiskPart
      where
    	mempty :: DiskPart
    mempty = DiskPart
    FixedDiskPart
    	mappend :: DiskPart -> DiskPart -> DiskPart
    mappend = DiskPart -> DiskPart -> DiskPart
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    -- | Make a partition use some percentage of the size of the disk
    -- (less all fixed size partitions), or the remaining space in the disk.
    useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart
    useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart
    useDiskSpace (mp :: Maybe FilePath
    mp, o :: MountOpts
    o, p :: PartSize -> Partition
    p, _) diskuse :: DiskSpaceUse
    diskuse = (Maybe FilePath
    mp, MountOpts
    o, PartSize -> Partition
    p, DiskSpaceUse -> DiskPart
    DynamicDiskPart DiskSpaceUse
    diskuse)

    -- | Default partition size when not otherwize specified is 128 MegaBytes.
    defSz :: PartSize
    defSz :: PartSize
    defSz = ByteSize -> PartSize
    MegaBytes 128

    -- | When a partition is sized to fit the files that live in it,
    -- this fudge factor is added to the size of the files. This is necessary
    -- since filesystems have some space overhead.
    --
    -- Add 2% for filesystem overhead. Rationalle for picking 2%:
    -- A filesystem with 1% overhead might just sneak by as acceptable.
    -- Double that just in case. Add an additional 3 mb to deal with
    -- non-scaling overhead of filesystems (eg, superblocks).
    -- Add an additional 200 mb for temp files, journals, etc.
    fudgeSz :: PartSize -> PartSize
    fudgeSz :: PartSize -> PartSize
    fudgeSz (MegaBytes n :: ByteSize
    n) = ByteSize -> PartSize
    MegaBytes (ByteSize
    n ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    + ByteSize
    n ByteSize -> ByteSize -> ByteSize
    forall a. Integral a => a -> a -> a
    `div` 100 ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    * 2 ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    + 3 ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    + 200)
    fudgeSz (Bytes n :: ByteSize
    n) = PartSize -> PartSize
    fudgeSz (ByteSize -> PartSize
    toPartSize ByteSize
    n)

    alignTo :: Alignment -> PartSize -> ByteSize
    alignTo :: Alignment -> PartSize -> ByteSize
    alignTo _ (Bytes n :: ByteSize
    n) = ByteSize
    n -- no alignment done for Bytes
    alignTo (Alignment alignment :: ByteSize
    alignment) partsize :: PartSize
    partsize
    	| ByteSize
    alignment ByteSize -> ByteSize -> Bool
    forall a. Ord a => a -> a -> Bool
    < 1 = ByteSize
    n
    	| Bool
    otherwise = case ByteSize -> ByteSize -> ByteSize
    forall a. Integral a => a -> a -> a
    rem ByteSize
    n ByteSize
    alignment of
    		0 -> ByteSize
    n
    		r :: ByteSize
    r -> ByteSize
    n ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    - ByteSize
    r ByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    + ByteSize
    alignment
      where
    	n :: ByteSize
    n = PartSize -> ByteSize
    fromPartSize PartSize
    partsize