{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

-- | Disk image partition specification.

module Propellor.Property.DiskImage.PartSpec (
	PartSpec,
	Fs(..),
	PartSize(..),
	partition,
	-- * PartSpec combinators
	swapPartition,
	rawPartition,
	mountedAt,
	addFreeSpace,
	setSize,
	mountOpt,
	errorReadonly,
	reservedSpacePercentage,
	setFlag,
	extended,
	-- * Partition properties
	--
	-- | These properties do not do any disk partitioning on their own, but
	-- the Info they set can be used when building a disk image for a
	-- host.
	hasPartition,
	adjustPartition,
	PartLocation(..),
	partLocation,
	hasPartitionTableType,
	TableType(..),
	PartInfo,
	toPartTableSpec,
	PartTableSpec(..)
) where

import Propellor.Base
import Propellor.Property.Parted
import Propellor.Types.PartSpec
import Propellor.Types.Info
import Propellor.Property.Mount

import Data.List (sortBy)
import Data.Ord
import qualified Data.Semigroup as Sem

-- | Specifies a partition with a given filesystem.
--
-- The partition is not mounted anywhere by default; use the combinators
-- below to configure it.
partition :: Monoid t => Fs -> PartSpec t
partition :: Fs -> PartSpec t
partition Fs
fs = (Maybe MountPoint
forall a. Maybe a
Nothing, MountOpts
forall a. Monoid a => a
mempty, Maybe Fs -> PartSize -> Partition
mkPartition (Fs -> Maybe Fs
forall a. a -> Maybe a
Just Fs
fs), t
forall a. Monoid a => a
mempty)

-- | Specifies a swap partition of a given size.
swapPartition :: Monoid t => PartSize -> PartSpec t
swapPartition :: PartSize -> PartSpec t
swapPartition PartSize
sz = (Maybe MountPoint
forall a. Maybe a
Nothing, MountOpts
forall a. Monoid a => a
mempty, Partition -> PartSize -> Partition
forall a b. a -> b -> a
const (Maybe Fs -> PartSize -> Partition
mkPartition (Fs -> Maybe Fs
forall a. a -> Maybe a
Just Fs
LinuxSwap) PartSize
sz), t
forall a. Monoid a => a
mempty)

-- | Specifies a partition without any filesystem, of a given size.
rawPartition :: Monoid t => PartSize -> PartSpec t
rawPartition :: PartSize -> PartSpec t
rawPartition PartSize
sz = (Maybe MountPoint
forall a. Maybe a
Nothing, MountOpts
forall a. Monoid a => a
mempty, Partition -> PartSize -> Partition
forall a b. a -> b -> a
const (Maybe Fs -> PartSize -> Partition
mkPartition Maybe Fs
forall a. Maybe a
Nothing PartSize
sz), t
forall a. Monoid a => a
mempty)

-- | Specifies where to mount a partition.
mountedAt :: PartSpec t -> MountPoint -> PartSpec t
mountedAt :: PartSpec t -> MountPoint -> PartSpec t
mountedAt (Maybe MountPoint
_, MountOpts
o, PartSize -> Partition
p, t
t) MountPoint
mp = (MountPoint -> Maybe MountPoint
forall a. a -> Maybe a
Just MountPoint
mp, MountOpts
o, PartSize -> Partition
p, t
t)

-- | Partitions in disk images default to being sized large enough to hold
-- the files that live in that partition.
--
-- This adds additional free space to a partition.
addFreeSpace :: PartSpec t -> PartSize -> PartSpec t
addFreeSpace :: PartSpec t -> PartSize -> PartSpec t
addFreeSpace (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, t
t) PartSize
freesz = (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p', t
t)
  where
	p' :: PartSize -> Partition
p' = \PartSize
sz -> PartSize -> Partition
p (PartSize
sz PartSize -> PartSize -> PartSize
forall a. Semigroup a => a -> a -> a
<> PartSize
freesz)

-- | Specify a fixed size for a partition.
setSize :: PartSpec t -> PartSize -> PartSpec t
setSize :: PartSpec t -> PartSize -> PartSpec t
setSize (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, t
t) PartSize
sz = (Maybe MountPoint
mp, MountOpts
o, Partition -> PartSize -> Partition
forall a b. a -> b -> a
const (PartSize -> Partition
p PartSize
sz), t
t)

-- | Specifies a mount option, such as "noexec"
mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t
mountOpt :: PartSpec t -> o -> PartSpec t
mountOpt (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, t
t) o
o' = (Maybe MountPoint
mp, MountOpts
o MountOpts -> MountOpts -> MountOpts
forall a. Semigroup a => a -> a -> a
<> o -> MountOpts
forall a. ToMountOpts a => a -> MountOpts
toMountOpts o
o', PartSize -> Partition
p, t
t)

-- | Mount option to make a partition be remounted readonly when there's an
-- error accessing it.
errorReadonly :: MountOpts
errorReadonly :: MountOpts
errorReadonly = MountPoint -> MountOpts
forall a. ToMountOpts a => a -> MountOpts
toMountOpts MountPoint
"errors=remount-ro"

-- | Sets the percent of the filesystem blocks reserved for the super-user.
--
-- The default is 5% for ext2 and ext4. Some filesystems may not support
-- this.
reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t
reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t
reservedSpacePercentage PartSpec t
s Int
percent = PartSpec t -> (Partition -> Partition) -> PartSpec t
forall t. PartSpec t -> (Partition -> Partition) -> PartSpec t
adjustp PartSpec t
s ((Partition -> Partition) -> PartSpec t)
-> (Partition -> Partition) -> PartSpec t
forall a b. (a -> b) -> a -> b
$ \Partition
p -> 
	Partition
p { partMkFsOpts :: MkfsOpts
partMkFsOpts = (MountPoint
"-m")MountPoint -> MkfsOpts -> MkfsOpts
forall a. a -> [a] -> [a]
:Int -> MountPoint
forall a. Show a => a -> MountPoint
show Int
percentMountPoint -> MkfsOpts -> MkfsOpts
forall a. a -> [a] -> [a]
:Partition -> MkfsOpts
partMkFsOpts Partition
p }

-- | Sets a flag on the partition.
setFlag :: PartSpec t -> PartFlag -> PartSpec t
setFlag :: PartSpec t -> PartFlag -> PartSpec t
setFlag PartSpec t
s PartFlag
f = PartSpec t -> (Partition -> Partition) -> PartSpec t
forall t. PartSpec t -> (Partition -> Partition) -> PartSpec t
adjustp PartSpec t
s ((Partition -> Partition) -> PartSpec t)
-> (Partition -> Partition) -> PartSpec t
forall a b. (a -> b) -> a -> b
$ \Partition
p -> Partition
p { partFlags :: [(PartFlag, Bool)]
partFlags = (PartFlag
f, Bool
True)(PartFlag, Bool) -> [(PartFlag, Bool)] -> [(PartFlag, Bool)]
forall a. a -> [a] -> [a]
:Partition -> [(PartFlag, Bool)]
partFlags Partition
p }

-- | Makes a MSDOS partition be Extended, rather than Primary.
extended :: PartSpec t -> PartSpec t
extended :: PartSpec t -> PartSpec t
extended PartSpec t
s = PartSpec t -> (Partition -> Partition) -> PartSpec t
forall t. PartSpec t -> (Partition -> Partition) -> PartSpec t
adjustp PartSpec t
s ((Partition -> Partition) -> PartSpec t)
-> (Partition -> Partition) -> PartSpec t
forall a b. (a -> b) -> a -> b
$ \Partition
p -> Partition
p { partType :: PartType
partType = PartType
Extended }

adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t
adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t
adjustp (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, t
t) Partition -> Partition
f = (Maybe MountPoint
mp, MountOpts
o, Partition -> Partition
f (Partition -> Partition)
-> (PartSize -> Partition) -> PartSize -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartSize -> Partition
p, t
t)

data PartInfoVal
	= TableTypeInfo TableType
	| PartSpecInfo (PartSpec PartLocation)
	| AdjustPartSpecInfo MountPoint (PartSpec PartLocation -> PartSpec PartLocation)

newtype PartInfo = PartInfo [PartInfoVal]
	deriving (Semigroup PartInfo
PartInfo
Semigroup PartInfo
-> PartInfo
-> (PartInfo -> PartInfo -> PartInfo)
-> ([PartInfo] -> PartInfo)
-> Monoid PartInfo
[PartInfo] -> PartInfo
PartInfo -> PartInfo -> PartInfo
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PartInfo] -> PartInfo
$cmconcat :: [PartInfo] -> PartInfo
mappend :: PartInfo -> PartInfo -> PartInfo
$cmappend :: PartInfo -> PartInfo -> PartInfo
mempty :: PartInfo
$cmempty :: PartInfo
$cp1Monoid :: Semigroup PartInfo
Monoid, b -> PartInfo -> PartInfo
NonEmpty PartInfo -> PartInfo
PartInfo -> PartInfo -> PartInfo
(PartInfo -> PartInfo -> PartInfo)
-> (NonEmpty PartInfo -> PartInfo)
-> (forall b. Integral b => b -> PartInfo -> PartInfo)
-> Semigroup PartInfo
forall b. Integral b => b -> PartInfo -> PartInfo
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PartInfo -> PartInfo
$cstimes :: forall b. Integral b => b -> PartInfo -> PartInfo
sconcat :: NonEmpty PartInfo -> PartInfo
$csconcat :: NonEmpty PartInfo -> PartInfo
<> :: PartInfo -> PartInfo -> PartInfo
$c<> :: PartInfo -> PartInfo -> PartInfo
Sem.Semigroup, Typeable)

instance IsInfo PartInfo where
	propagateInfo :: PartInfo -> PropagateInfo
propagateInfo PartInfo
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

instance Show PartInfo where
	show :: PartInfo -> MountPoint
show = PartTableSpec -> MountPoint
forall a. Show a => a -> MountPoint
show (PartTableSpec -> MountPoint)
-> (PartInfo -> PartTableSpec) -> PartInfo -> MountPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartInfo -> PartTableSpec
toPartTableSpec

toPartTableSpec :: PartInfo -> PartTableSpec
toPartTableSpec :: PartInfo -> PartTableSpec
toPartTableSpec (PartInfo [PartInfoVal]
l) = TableType -> [PartSpec ()] -> PartTableSpec
PartTableSpec TableType
tt [PartSpec ()]
pil
  where
	tt :: TableType
tt = TableType -> Maybe TableType -> TableType
forall a. a -> Maybe a -> a
fromMaybe TableType
MSDOS (Maybe TableType -> TableType) -> Maybe TableType -> TableType
forall a b. (a -> b) -> a -> b
$ [TableType] -> Maybe TableType
forall a. [a] -> Maybe a
headMaybe ([TableType] -> Maybe TableType) -> [TableType] -> Maybe TableType
forall a b. (a -> b) -> a -> b
$ [TableType] -> [TableType]
forall a. [a] -> [a]
reverse ([TableType] -> [TableType]) -> [TableType] -> [TableType]
forall a b. (a -> b) -> a -> b
$ (PartInfoVal -> Maybe TableType) -> [PartInfoVal] -> [TableType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PartInfoVal -> Maybe TableType
gettt [PartInfoVal]
l

	pil :: [PartSpec ()]
pil = ((Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
 -> PartSpec ())
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
-> [PartSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> PartSpec ()
forall a b c d. (a, b, c, d) -> (a, b, c, ())
convert ([(Maybe MountPoint, MountOpts, PartSize -> Partition,
   PartLocation)]
 -> [PartSpec ()])
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
-> [PartSpec ()]
forall a b. (a -> b) -> a -> b
$ ((Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
 -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)
 -> Ordering)
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
 -> PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> PartLocation
forall a b c d. (a, b, c, d) -> d
location) ([(Maybe MountPoint, MountOpts, PartSize -> Partition,
   PartLocation)]
 -> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
      PartLocation)])
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
forall a b. (a -> b) -> a -> b
$ [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
adjust [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
collect
	collect :: [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
collect = (PartInfoVal
 -> Maybe
      (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation))
-> [PartInfoVal]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PartInfoVal
-> Maybe
     (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
getspartspec [PartInfoVal]
l
	adjust :: [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
adjust [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
ps = [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
-> [(MountPoint,
     (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
     -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
         PartLocation))]
-> [(Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)]
forall a b c d.
Eq a =>
[(Maybe a, b, c, d)]
-> [(a, (Maybe a, b, c, d) -> (Maybe a, b, c, d))]
-> [(Maybe a, b, c, d)]
adjust' [(Maybe MountPoint, MountOpts, PartSize -> Partition,
  PartLocation)]
ps ((PartInfoVal
 -> Maybe
      (MountPoint,
       (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
       -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
           PartLocation)))
-> [PartInfoVal]
-> [(MountPoint,
     (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
     -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
         PartLocation))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PartInfoVal
-> Maybe
     (MountPoint,
      (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
      -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
          PartLocation))
getadjust [PartInfoVal]
l)
	adjust' :: [(Maybe a, b, c, d)]
-> [(a, (Maybe a, b, c, d) -> (Maybe a, b, c, d))]
-> [(Maybe a, b, c, d)]
adjust' [(Maybe a, b, c, d)]
ps [] = [(Maybe a, b, c, d)]
ps
	adjust' [(Maybe a, b, c, d)]
ps ((a
mp, (Maybe a, b, c, d) -> (Maybe a, b, c, d)
f):[(a, (Maybe a, b, c, d) -> (Maybe a, b, c, d))]
rest) = [(Maybe a, b, c, d)]
-> [(a, (Maybe a, b, c, d) -> (Maybe a, b, c, d))]
-> [(Maybe a, b, c, d)]
adjust' (((Maybe a, b, c, d) -> (Maybe a, b, c, d))
-> [(Maybe a, b, c, d)] -> [(Maybe a, b, c, d)]
forall a b. (a -> b) -> [a] -> [b]
map (a
-> ((Maybe a, b, c, d) -> (Maybe a, b, c, d))
-> (Maybe a, b, c, d)
-> (Maybe a, b, c, d)
forall a b c d.
Eq a =>
a
-> ((Maybe a, b, c, d) -> (Maybe a, b, c, d))
-> (Maybe a, b, c, d)
-> (Maybe a, b, c, d)
adjustone a
mp (Maybe a, b, c, d) -> (Maybe a, b, c, d)
f) [(Maybe a, b, c, d)]
ps) [(a, (Maybe a, b, c, d) -> (Maybe a, b, c, d))]
rest
	adjustone :: a
-> ((Maybe a, b, c, d) -> (Maybe a, b, c, d))
-> (Maybe a, b, c, d)
-> (Maybe a, b, c, d)
adjustone a
mp (Maybe a, b, c, d) -> (Maybe a, b, c, d)
f p :: (Maybe a, b, c, d)
p@(Maybe a
mp', b
_, c
_, d
_)
		| a -> Maybe a
forall a. a -> Maybe a
Just a
mp Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a
mp' = (Maybe a, b, c, d) -> (Maybe a, b, c, d)
f (Maybe a, b, c, d)
p
		| Bool
otherwise = (Maybe a, b, c, d)
p
	location :: (a, b, c, d) -> d
location (a
_, b
_, c
_, d
loc) = d
loc
	convert :: (a, b, c, d) -> (a, b, c, ())
convert (a
mp, b
o, c
p, d
_) = (a
mp, b
o, c
p, ())
	
	gettt :: PartInfoVal -> Maybe TableType
gettt (TableTypeInfo TableType
t) = TableType -> Maybe TableType
forall a. a -> Maybe a
Just TableType
t
	gettt PartInfoVal
_ = Maybe TableType
forall a. Maybe a
Nothing
	getspartspec :: PartInfoVal
-> Maybe
     (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
getspartspec (PartSpecInfo (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
ps) = (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> Maybe
     (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
forall a. a -> Maybe a
Just (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
ps
	getspartspec PartInfoVal
_ = Maybe
  (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
forall a. Maybe a
Nothing
	getadjust :: PartInfoVal
-> Maybe
     (MountPoint,
      (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
      -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
          PartLocation))
getadjust (AdjustPartSpecInfo MountPoint
mp (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
f) = (MountPoint,
 (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
 -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation))
-> Maybe
     (MountPoint,
      (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
      -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
          PartLocation))
forall a. a -> Maybe a
Just (MountPoint
mp, (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
f)
	getadjust PartInfoVal
_ = Maybe
  (MountPoint,
   (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
   -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
       PartLocation))
forall a. Maybe a
Nothing

-- | Indicates the partition table type of a host.
--
-- When not specified, the default is MSDOS.
--
-- For example:
--
-- >	& hasPartitionTableType GPT
hasPartitionTableType :: TableType -> Property (HasInfo + UnixLike)
hasPartitionTableType :: TableType -> Property (HasInfo + UnixLike)
hasPartitionTableType TableType
tt = MountPoint -> PartInfo -> Property (HasInfo + UnixLike)
forall v.
IsInfo v =>
MountPoint -> v -> Property (HasInfo + UnixLike)
pureInfoProperty
	(MountPoint
"partition table type " MountPoint -> ShowS
forall a. [a] -> [a] -> [a]
++ TableType -> MountPoint
forall a. Show a => a -> MountPoint
show TableType
tt)
	([PartInfoVal] -> PartInfo
PartInfo [TableType -> PartInfoVal
TableTypeInfo TableType
tt])

-- | Indicates that a host has a partition.
--
-- For example:
--
-- >	& hasPartiton (partition EXT2 `mountedAt` "/boot" `partLocation` Beginning)
-- >	& hasPartiton (partition EXT4 `mountedAt` "/")
-- >	& hasPartiton (partition EXT4 `mountedAt` "/home" `partLocation` End `reservedSpacePercentage` 0)
hasPartition :: PartSpec PartLocation -> Property (HasInfo + UnixLike)
hasPartition :: (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> Property (HasInfo + UnixLike)
hasPartition p :: (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
p@(Maybe MountPoint
mmp, MountOpts
_, PartSize -> Partition
_, PartLocation
_) = MountPoint -> PartInfo -> Property (HasInfo + UnixLike)
forall v.
IsInfo v =>
MountPoint -> v -> Property (HasInfo + UnixLike)
pureInfoProperty MountPoint
desc
	([PartInfoVal] -> PartInfo
PartInfo [(Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> PartInfoVal
PartSpecInfo (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
p])
  where
	desc :: MountPoint
desc = case Maybe MountPoint
mmp of
		Just MountPoint
mp -> MountPoint
mp MountPoint -> ShowS
forall a. [a] -> [a] -> [a]
++ MountPoint
" partition"
		Maybe MountPoint
Nothing -> MountPoint
"unmounted partition"

-- | Adjusts the PartSpec for the partition mounted at the specified location.
--
-- For example:
--
-- > 	& adjustPartition "/boot" (`addFreeSpace` MegaBytes 150)
adjustPartition :: MountPoint -> (PartSpec PartLocation -> PartSpec PartLocation) -> Property (HasInfo + UnixLike)
adjustPartition :: MountPoint
-> ((Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)
    -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
        PartLocation))
-> Property (HasInfo + UnixLike)
adjustPartition MountPoint
mp (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
f = MountPoint -> PartInfo -> Property (HasInfo + UnixLike)
forall v.
IsInfo v =>
MountPoint -> v -> Property (HasInfo + UnixLike)
pureInfoProperty
	(MountPoint
mp MountPoint -> ShowS
forall a. [a] -> [a] -> [a]
++ MountPoint
" adjusted")
	([PartInfoVal] -> PartInfo
PartInfo [MountPoint
-> ((Maybe MountPoint, MountOpts, PartSize -> Partition,
     PartLocation)
    -> (Maybe MountPoint, MountOpts, PartSize -> Partition,
        PartLocation))
-> PartInfoVal
AdjustPartSpecInfo MountPoint
mp (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
f])

-- | Indicates partition layout in a disk. Default is somewhere in the
-- middle.
data PartLocation = Beginning | Middle | End
	deriving (PartLocation -> PartLocation -> Bool
(PartLocation -> PartLocation -> Bool)
-> (PartLocation -> PartLocation -> Bool) -> Eq PartLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartLocation -> PartLocation -> Bool
$c/= :: PartLocation -> PartLocation -> Bool
== :: PartLocation -> PartLocation -> Bool
$c== :: PartLocation -> PartLocation -> Bool
Eq, Eq PartLocation
Eq PartLocation
-> (PartLocation -> PartLocation -> Ordering)
-> (PartLocation -> PartLocation -> Bool)
-> (PartLocation -> PartLocation -> Bool)
-> (PartLocation -> PartLocation -> Bool)
-> (PartLocation -> PartLocation -> Bool)
-> (PartLocation -> PartLocation -> PartLocation)
-> (PartLocation -> PartLocation -> PartLocation)
-> Ord PartLocation
PartLocation -> PartLocation -> Bool
PartLocation -> PartLocation -> Ordering
PartLocation -> PartLocation -> PartLocation
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 :: PartLocation -> PartLocation -> PartLocation
$cmin :: PartLocation -> PartLocation -> PartLocation
max :: PartLocation -> PartLocation -> PartLocation
$cmax :: PartLocation -> PartLocation -> PartLocation
>= :: PartLocation -> PartLocation -> Bool
$c>= :: PartLocation -> PartLocation -> Bool
> :: PartLocation -> PartLocation -> Bool
$c> :: PartLocation -> PartLocation -> Bool
<= :: PartLocation -> PartLocation -> Bool
$c<= :: PartLocation -> PartLocation -> Bool
< :: PartLocation -> PartLocation -> Bool
$c< :: PartLocation -> PartLocation -> Bool
compare :: PartLocation -> PartLocation -> Ordering
$ccompare :: PartLocation -> PartLocation -> Ordering
$cp1Ord :: Eq PartLocation
Ord)

instance Sem.Semigroup PartLocation where
	PartLocation
_ <> :: PartLocation -> PartLocation -> PartLocation
<> PartLocation
b = PartLocation
b

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

partLocation :: PartSpec PartLocation -> PartLocation -> PartSpec PartLocation
partLocation :: (Maybe MountPoint, MountOpts, PartSize -> Partition, PartLocation)
-> PartLocation
-> (Maybe MountPoint, MountOpts, PartSize -> Partition,
    PartLocation)
partLocation (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, PartLocation
_) PartLocation
l = (Maybe MountPoint
mp, MountOpts
o, PartSize -> Partition
p, PartLocation
l)