module Propellor.Property.ConfFile (
SectionStart,
SectionPast,
AdjustSection,
InsertSection,
adjustSection,
IniSection,
IniKey,
containsIniSetting,
lacksIniSetting,
hasIniSection,
lacksIniSection,
iniFileContains,
ShellKey,
containsShellSetting,
lacksShellSetting,
) where
import Propellor.Base
import Propellor.Property.File
import Data.List (isPrefixOf, foldl')
type SectionStart = Line -> Bool
type SectionPast = Line -> Bool
type AdjustSection = [Line] -> [Line]
type InsertSection = [Line] -> [Line]
adjustSection
:: Desc
-> SectionStart
-> SectionPast
-> AdjustSection
-> InsertSection
-> FilePath
-> Property UnixLike
adjustSection :: Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection desc :: Desc
desc start :: SectionStart
start past :: SectionStart
past adjust :: AdjustSection
adjust insert :: AdjustSection
insert = Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty Desc
desc AdjustSection
go
where
go :: AdjustSection
go ls :: [Desc]
ls = let (pre :: [Desc]
pre, wanted :: [Desc]
wanted, post :: [Desc]
post) = (([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc]))
-> ([Desc], [Desc], [Desc]) -> [Desc] -> ([Desc], [Desc], [Desc])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([], [], []) [Desc]
ls
in if [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted
then AdjustSection
insert [Desc]
ls
else [Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ AdjustSection
adjust [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc]
post
find :: ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find (pre :: [Desc]
pre, wanted :: [Desc]
wanted, post :: [Desc]
post) l :: Desc
l
| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
start) Desc
l =
([Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
wanted, [Desc]
post)
| (SectionStart
start Desc
l Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post)
Bool -> Bool -> Bool
|| ((Bool -> Bool
not (Bool -> Bool) -> ([Desc] -> Bool) -> [Desc] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Desc]
wanted Bool -> Bool -> Bool
&& [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
post Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
past) Desc
l) =
([Desc]
pre, [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
post)
| Bool
otherwise = ([Desc]
pre, [Desc]
wanted, [Desc]
post [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l])
type IniSection = String
type IniKey = String
iniHeader :: IniSection -> String
header :: Desc
header = '[' Char -> Desc -> Desc
forall a. a -> [a] -> [a]
: Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "]"
adjustIniSection
:: Desc
-> IniSection
-> AdjustSection
-> InsertSection
-> FilePath
-> Property UnixLike
adjustIniSection :: Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection desc :: Desc
desc header :: Desc
header =
Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection
Desc
desc
(Desc -> SectionStart
forall a. Eq a => a -> a -> Bool
== Desc -> Desc
iniHeader Desc
header)
("[" Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
containsIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
containsIniSetting :: Desc -> (Desc, Desc, Desc) -> Property UnixLike
containsIniSetting f :: Desc
f (header :: Desc
header, key :: Desc
key, value :: Desc
value) = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "] contains " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value)
Desc
header
AdjustSection
go
([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
confheader, Desc
confline])
Desc
f
where
confheader :: Desc
confheader = Desc -> Desc
iniHeader Desc
header
confline :: Desc
confline = Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value
go :: AdjustSection
go [] = [Desc
confline]
go (l :: Desc
l:ls :: [Desc]
ls) = if SectionStart
isKeyVal Desc
l then Desc
confline Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
ls else Desc
l Desc -> AdjustSection
forall a. a -> [a] -> [a]
: AdjustSection
go [Desc]
ls
isKeyVal :: SectionStart
isKeyVal x :: Desc
x = ((Char -> Bool) -> Desc -> Desc
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ') (Desc -> Desc) -> (Desc -> Desc) -> Desc -> Desc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Desc -> Desc
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '=')) Desc
x Desc -> [Desc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Desc
key, '#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
key]
lacksIniSetting :: FilePath -> (IniSection, IniKey, String) -> Property UnixLike
lacksIniSetting :: Desc -> (Desc, Desc, Desc) -> Property UnixLike
lacksIniSetting f :: Desc
f (header :: Desc
header, key :: Desc
key, value :: Desc
value) = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "] lacks " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value)
Desc
header
(SectionStart -> AdjustSection
forall a. (a -> Bool) -> [a] -> [a]
filter (Desc -> SectionStart
forall a. Eq a => a -> a -> Bool
/= Desc
confline))
AdjustSection
forall a. a -> a
id
Desc
f
where
confline :: Desc
confline = Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value
hasIniSection :: FilePath -> IniSection -> [(IniKey, String)] -> Property UnixLike
hasIniSection :: Desc -> Desc -> [(Desc, Desc)] -> Property UnixLike
hasIniSection f :: Desc
f header :: Desc
header keyvalues :: [(Desc, Desc)]
keyvalues = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
("set " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "]")
Desc
header
AdjustSection
forall p. p -> [Desc]
go
([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ Desc
confheader Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
conflines)
Desc
f
where
confheader :: Desc
confheader = Desc -> Desc
iniHeader Desc
header
conflines :: [Desc]
conflines = ((Desc, Desc) -> Desc) -> [(Desc, Desc)] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map (\(key :: Desc
key, value :: Desc
value) -> Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value) [(Desc, Desc)]
keyvalues
go :: p -> [Desc]
go _ = Desc
confheader Desc -> AdjustSection
forall a. a -> [a] -> [a]
: [Desc]
conflines
lacksIniSection :: FilePath -> IniSection -> Property UnixLike
lacksIniSection :: Desc -> Desc -> Property UnixLike
lacksIniSection f :: Desc
f header :: Desc
header = Desc
-> Desc
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustIniSection
(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " lacks section [" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
header Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "]")
Desc
header
([Desc] -> AdjustSection
forall a b. a -> b -> a
const [])
AdjustSection
forall a. a -> a
id
Desc
f
iniFileContains :: FilePath -> [(IniSection, [(IniKey, String)])] -> RevertableProperty UnixLike UnixLike
iniFileContains :: Desc
-> [(Desc, [(Desc, Desc)])] -> RevertableProperty UnixLike UnixLike
iniFileContains f :: Desc
f l :: [(Desc, [(Desc, Desc)])]
l = Desc
f Desc -> [Desc] -> Property UnixLike
`hasContent` [Desc]
content Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Desc -> Property UnixLike
notPresent Desc
f
where
content :: [Desc]
content = ((Desc, [(Desc, Desc)]) -> [Desc])
-> [(Desc, [(Desc, Desc)])] -> [Desc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Desc, [(Desc, Desc)]) -> [Desc]
sectioncontent [(Desc, [(Desc, Desc)])]
l
sectioncontent :: (Desc, [(Desc, Desc)]) -> [Desc]
sectioncontent (section :: Desc
section, keyvalues :: [(Desc, Desc)]
keyvalues) = Desc -> Desc
iniHeader Desc
section Desc -> AdjustSection
forall a. a -> [a] -> [a]
:
((Desc, Desc) -> Desc) -> [(Desc, Desc)] -> [Desc]
forall a b. (a -> b) -> [a] -> [b]
map (\(key :: Desc
key, value :: Desc
value) -> Desc
key Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
value) [(Desc, Desc)]
keyvalues
type ShellKey = String
containsShellSetting :: FilePath -> (ShellKey, String) -> Property UnixLike
containsShellSetting :: Desc -> (Desc, Desc) -> Property UnixLike
containsShellSetting f :: Desc
f (k :: Desc
k, v :: Desc
v) = Property UnixLike
adjust Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
dedup
where
adjust :: Property UnixLike
adjust = Desc
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> Desc
-> Property UnixLike
adjustSection
(Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ " contains " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
v)
SectionStart
isline
(Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline)
([Desc] -> AdjustSection
forall a b. a -> b -> a
const [Desc
line])
([Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
line])
Desc
f
dedup :: Property UnixLike
dedup = Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty "" AdjustSection
forall (t :: * -> *). Foldable t => t Desc -> [Desc]
dedup' Desc
f
dedup' :: t Desc -> [Desc]
dedup' ls :: t Desc
ls = let (pre :: [Desc]
pre, wanted :: [Desc]
wanted, post :: [Desc]
post) = (([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc]))
-> ([Desc], [Desc], [Desc]) -> t Desc -> ([Desc], [Desc], [Desc])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find ([], [], []) t Desc
ls
in [Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc]
wanted [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ (Desc -> Desc) -> AdjustSection
forall a b. (a -> b) -> [a] -> [b]
map Desc -> Desc
commentIfIsline [Desc]
post
find :: ([Desc], [Desc], [Desc]) -> Desc -> ([Desc], [Desc], [Desc])
find (pre :: [Desc]
pre, wanted :: [Desc]
wanted, post :: [Desc]
post) l :: Desc
l
| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> SectionStart -> SectionStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline) Desc
l = ([Desc]
pre [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l], [Desc]
wanted, [Desc]
post)
| [Desc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Desc]
wanted Bool -> Bool -> Bool
&& SectionStart
isline Desc
l = ([Desc]
pre, [Desc
l], [Desc]
post)
| Bool
otherwise = ([Desc]
pre, [Desc]
wanted, [Desc]
post [Desc] -> AdjustSection
forall a. [a] -> [a] -> [a]
++ [Desc
l])
commentIfIsline :: Desc -> Desc
commentIfIsline l :: Desc
l
| SectionStart
isline Desc
l = '#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
l
| Bool
otherwise = Desc
l
isline :: SectionStart
isline s :: Desc
s = (Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=") Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
s
line :: Desc
line = Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc -> Desc
shellEscape Desc
v
lacksShellSetting :: FilePath -> (ShellKey, String) -> Property UnixLike
lacksShellSetting :: Desc -> (Desc, Desc) -> Property UnixLike
lacksShellSetting f :: Desc
f (k :: Desc
k, v :: Desc
v) =
Desc -> AdjustSection -> Desc -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Desc -> (c -> c) -> Desc -> Property UnixLike
fileProperty (Desc
f Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "lacks shell setting " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=" Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
v) AdjustSection
go Desc
f
where
go :: AdjustSection
go ls :: [Desc]
ls = (Desc -> Desc) -> AdjustSection
forall a b. (a -> b) -> [a] -> [b]
map Desc -> Desc
commentOut [Desc]
ls
commentOut :: Desc -> Desc
commentOut l :: Desc
l
| (Desc
k Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ "=") Desc -> SectionStart
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
l = '#'Char -> Desc -> Desc
forall a. a -> [a] -> [a]
:Desc
l
| Bool
otherwise = Desc
l