{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
module Propellor.Property.File where
import Propellor.Base
import qualified Data.ByteString.Lazy as L
import Data.List (isInfixOf, isPrefixOf)
import System.Posix.Files
import System.Exit
import Data.Char
type Line = String
hasContent :: FilePath -> [Line] -> Property UnixLike
Line
f hasContent :: Line -> [Line] -> Property UnixLike
`hasContent` [Line]
newcontent = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty
(Line
"replace " forall a. [a] -> [a] -> [a]
++ Line
f)
(\[Line]
_oldcontent -> [Line]
newcontent) Line
f
containsLine :: FilePath -> Line -> Property UnixLike
Line
f containsLine :: Line -> Line -> Property UnixLike
`containsLine` Line
l = Line
f Line -> [Line] -> Property UnixLike
`containsLines` [Line
l]
containsLines :: FilePath -> [Line] -> Property UnixLike
Line
f containsLines :: Line -> [Line] -> Property UnixLike
`containsLines` [Line]
ls = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" contains:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
go Line
f
where
go :: [Line] -> [Line]
go [Line]
content = [Line]
content forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
content) [Line]
ls
containsBlock :: FilePath -> [Line] -> RevertableProperty UnixLike UnixLike
Line
f containsBlock :: Line -> [Line] -> RevertableProperty UnixLike UnixLike
`containsBlock` [Line]
ls =
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" contains block:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
add Line
f
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" lacks block:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
remove Line
f
where
add :: [Line] -> [Line]
add [Line]
content
| [Line]
ls forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Line]
content = [Line]
content
| Bool
otherwise = [Line]
content forall a. [a] -> [a] -> [a]
++ [Line]
ls
remove :: [Line] -> [Line]
remove [] = []
remove content :: [Line]
content@(Line
x:[Line]
xs)
| [Line]
ls forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Line]
content = [Line] -> [Line]
remove (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Line]
ls) [Line]
content)
| Bool
otherwise = Line
x forall a. a -> [a] -> [a]
: [Line] -> [Line]
remove [Line]
xs
lacksLine :: FilePath -> Line -> Property UnixLike
Line
f lacksLine :: Line -> Line -> Property UnixLike
`lacksLine` Line
l = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" remove: " forall a. [a] -> [a] -> [a]
++ Line
l) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Line
l)) Line
f
lacksLines :: FilePath -> [Line] -> Property UnixLike
Line
f lacksLines :: Line -> [Line] -> Property UnixLike
`lacksLines` [Line]
ls = forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f forall a. [a] -> [a] -> [a]
++ Line
" remove: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show [[Line]
ls]) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
ls)) Line
f
hasContentProtected :: FilePath -> [Line] -> Property UnixLike
Line
f hasContentProtected :: Line -> [Line] -> Property UnixLike
`hasContentProtected` [Line]
newcontent = forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
ProtectedWrite
(Line
"replace " forall a. [a] -> [a] -> [a]
++ Line
f)
(\[Line]
_oldcontent -> [Line]
newcontent) Line
f
hasPrivContent :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent :: forall c. IsContext c => Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent Line
f = forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom (PrivDataField -> Line -> PrivDataSource
PrivDataSourceFile (Line -> PrivDataField
PrivFile Line
f) Line
f) Line
f
hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom :: forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentFrom = forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
ProtectedWrite
hasPrivContentExposed :: IsContext c => FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposed :: forall c. IsContext c => Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposed Line
f = forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom (PrivDataField -> Line -> PrivDataSource
PrivDataSourceFile (Line -> PrivDataField
PrivFile Line
f) Line
f) Line
f
hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom :: forall c s.
(IsContext c, IsPrivDataSource s) =>
s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContentExposedFrom = forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
NormalWrite
hasPrivContent' :: (IsContext c, IsPrivDataSource s) => FileWriteMode -> s -> FilePath -> c -> Property (HasInfo + UnixLike)
hasPrivContent' :: forall c s.
(IsContext c, IsPrivDataSource s) =>
FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
hasPrivContent' FileWriteMode
writemode s
source Line
f c
context =
forall c s metatypes.
(IsContext c, IsPrivDataSource s,
IncludesInfo metatypes ~ 'True) =>
s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property metatypes)
-> Property metatypes
withPrivData s
source c
context forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getcontent ->
forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> (PrivData -> Propellor Result) -> Propellor Result
getcontent forall a b. (a -> b) -> a -> b
$ \PrivData
privcontent ->
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o forall a b. (a -> b) -> a -> b
$ forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
writemode Line
desc
(\ByteString
_oldcontent -> PrivData -> ByteString
privDataByteString PrivData
privcontent) Line
f
where
desc :: Line
desc = Line
"privcontent " forall a. [a] -> [a] -> [a]
++ Line
f
basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike
Line
f basedOn :: Line -> (Line, [Line] -> [Line]) -> Property UnixLike
`basedOn` (Line
src, [Line] -> [Line]
a) = forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> do
Line
tmpl <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readFile Line
src
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o forall a b. (a -> b) -> a -> b
$ forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty Line
desc (\[Line]
_ -> [Line] -> [Line]
a forall a b. (a -> b) -> a -> b
$ Line -> [Line]
lines forall a b. (a -> b) -> a -> b
$ Line
tmpl) Line
f
where
desc :: Line
desc = Line
f forall a. [a] -> [a] -> [a]
++ Line
" is based on " forall a. [a] -> [a] -> [a]
++ Line
src
notPresent :: FilePath -> Property UnixLike
notPresent :: Line -> Property UnixLike
notPresent Line
f = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Line -> IO Bool
doesFileExist Line
f) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f forall a. [a] -> [a] -> [a]
++ Line
" not present") forall a b. (a -> b) -> a -> b
$
IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
nukeFile Line
f
dirExists :: FilePath -> Property UnixLike
dirExists :: Line -> Property UnixLike
dirExists Line
d = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesDirectoryExist Line
d) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
d forall a. [a] -> [a] -> [a]
++ Line
" exists") forall a b. (a -> b) -> a -> b
$
IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Bool -> Line -> IO ()
createDirectoryIfMissing Bool
True Line
d
newtype LinkTarget = LinkTarget FilePath
isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike
Line
link isSymlinkedTo :: Line -> LinkTarget -> RevertableProperty UnixLike UnixLike
`isSymlinkedTo` (LinkTarget Line
target) = Property UnixLike
linked forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
notLinked
where
linked :: Property UnixLike
linked = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link forall a. [a] -> [a] -> [a]
++ Line
" is symlinked to " forall a. [a] -> [a] -> [a]
++ Line
target) forall a b. (a -> b) -> a -> b
$
forall {a}. Either a FileStatus -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Either IOException FileStatus)
getLinkStatus
go :: Either a FileStatus -> Propellor Result
go (Right FileStatus
stat) =
if FileStatus -> Bool
isSymbolicLink FileStatus
stat
then Propellor Result
checkLink
else Propellor Result
nonSymlinkExists
go (Left a
_) = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
createSymbolicLink Line
target Line
link
notLinked :: Property UnixLike
notLinked = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link forall a. [a] -> [a] -> [a]
++ Line
"does not exist as a symlink") forall a b. (a -> b) -> a -> b
$
forall {a}. Either a FileStatus -> Propellor Result
stop forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Either IOException FileStatus)
getLinkStatus
stop :: Either a FileStatus -> Propellor Result
stop (Right FileStatus
stat) =
if FileStatus -> Bool
isSymbolicLink FileStatus
stat
then IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
nukeFile Line
link
else Propellor Result
nonSymlinkExists
stop (Left a
_) = Propellor Result
noChange
nonSymlinkExists :: Propellor Result
nonSymlinkExists = do
forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ Line
link forall a. [a] -> [a] -> [a]
++ Line
" exists and is not a symlink"
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
checkLink :: Propellor Result
checkLink = do
Line
target' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readSymbolicLink Line
link
if Line
target forall a. Eq a => a -> a -> Bool
== Line
target'
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange IO ()
updateLink
updateLink :: IO ()
updateLink = Line -> Line -> IO ()
createSymbolicLink Line
target forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
link
getLinkStatus :: Propellor (Either IOException FileStatus)
getLinkStatus = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO FileStatus
getSymbolicLinkStatus Line
link
isCopyOf :: FilePath -> FilePath -> Property UnixLike
Line
f isCopyOf :: Line -> Line -> Property UnixLike
`isCopyOf` Line
src = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => Either a FileStatus -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO FileStatus
getFileStatus Line
src)
where
desc :: Line
desc = Line
f forall a. [a] -> [a] -> [a]
++ Line
" is copy of " forall a. [a] -> [a] -> [a]
++ Line
src
go :: Either a FileStatus -> Propellor Result
go (Right FileStatus
stat) = if FileStatus -> Bool
isRegularFile FileStatus
stat
then forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> IO Bool
doesFileExist Line
f)
( ExitCode -> Propellor Result
gocmp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO ExitCode
cmp)
, Propellor Result
doit
)
else forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (Line
src forall a. [a] -> [a] -> [a]
++ Line
" is not a regular file") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
go (Left a
e) = forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (forall a. Show a => a -> Line
show a
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
cmp :: IO ExitCode
cmp = Line -> [CommandParam] -> IO ExitCode
safeSystem Line
"cmp" [Line -> CommandParam
Param Line
"-s", Line -> CommandParam
Param Line
"--", Line -> CommandParam
File Line
f, Line -> CommandParam
File Line
src]
gocmp :: ExitCode -> Propellor Result
gocmp ExitCode
ExitSuccess = Propellor Result
noChange
gocmp (ExitFailure Int
1) = Propellor Result
doit
gocmp ExitCode
_ = forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage Line
"cmp failed" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
doit :: Propellor Result
doit = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> IO ()
copy forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
copy :: Line -> IO ()
copy Line
dest = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (Line -> IO Bool
runcp Line
dest) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Line -> m a
errorMessage Line
"cp failed"
runcp :: Line -> IO Bool
runcp Line
dest = Line -> [CommandParam] -> IO Bool
boolSystem Line
"cp"
[Line -> CommandParam
Param Line
"--preserve=all", Line -> CommandParam
Param Line
"--", Line -> CommandParam
File Line
src, Line -> CommandParam
File Line
dest]
ownerGroup :: FilePath -> User -> Group -> Property UnixLike
ownerGroup :: Line -> User -> Group -> Property UnixLike
ownerGroup Line
f (User Line
owner) (Group Line
group) = Property UnixLike
p forall p. IsProp p => p -> Line -> p
`describe` (Line
f forall a. [a] -> [a] -> [a]
++ Line
" owner " forall a. [a] -> [a] -> [a]
++ Line
og)
where
p :: Property UnixLike
p = Line -> [Line] -> UncheckedProperty UnixLike
cmdProperty Line
"chown" [Line
og, Line
f]
forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
og :: Line
og = Line
owner forall a. [a] -> [a] -> [a]
++ Line
":" forall a. [a] -> [a] -> [a]
++ Line
group
applyPath :: Monoid (Property metatypes) => FilePath -> FilePath -> (FilePath -> Property metatypes) -> Property metatypes
applyPath :: forall metatypes.
Monoid (Property metatypes) =>
Line -> Line -> (Line -> Property metatypes) -> Property metatypes
applyPath Line
basedir Line
relpath Line -> Property metatypes
mkp = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map Line -> Property metatypes
mkp (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Line -> Line -> Line
(</>) Line
basedir (Line -> [Line]
splitPath Line
relpath))
mode :: FilePath -> FileMode -> Property UnixLike
mode :: Line -> FileMode -> Property UnixLike
mode Line
f FileMode
v = Property UnixLike
p forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
where
p :: Property UnixLike
p = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f forall a. [a] -> [a] -> [a]
++ Line
" mode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Line
show FileMode
v) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> (FileMode -> FileMode) -> IO ()
modifyFileMode Line
f (forall a b. a -> b -> a
const FileMode
v)
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
class FileContent c where
emptyFileContent :: c
readFileContent :: FilePath -> IO c
writeFileContent :: FileWriteMode -> FilePath -> c -> IO ()
data FileWriteMode = NormalWrite | ProtectedWrite
instance FileContent [Line] where
emptyFileContent :: [Line]
emptyFileContent = []
readFileContent :: Line -> IO [Line]
readFileContent Line
f = Line -> [Line]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Line
readFile Line
f
writeFileContent :: FileWriteMode -> Line -> [Line] -> IO ()
writeFileContent FileWriteMode
NormalWrite Line
f [Line]
ls = Line -> Line -> IO ()
writeFile Line
f ([Line] -> Line
unlines [Line]
ls)
writeFileContent FileWriteMode
ProtectedWrite Line
f [Line]
ls = Line -> Line -> IO ()
writeFileProtected Line
f ([Line] -> Line
unlines [Line]
ls)
instance FileContent L.ByteString where
emptyFileContent :: ByteString
emptyFileContent = ByteString
L.empty
readFileContent :: Line -> IO ByteString
readFileContent = Line -> IO ByteString
L.readFile
writeFileContent :: FileWriteMode -> Line -> ByteString -> IO ()
writeFileContent FileWriteMode
NormalWrite Line
f ByteString
c = Line -> ByteString -> IO ()
L.writeFile Line
f ByteString
c
writeFileContent FileWriteMode
ProtectedWrite Line
f ByteString
c =
Line -> (Handle -> IO ()) -> IO ()
writeFileProtected' Line
f (Handle -> ByteString -> IO ()
`L.hPutStr` ByteString
c)
fileProperty :: (FileContent c, Eq c) => Desc -> (c -> c) -> FilePath -> Property UnixLike
fileProperty :: forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty = forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
NormalWrite
fileProperty' :: (FileContent c, Eq c) => FileWriteMode -> Desc -> (c -> c) -> FilePath -> Property UnixLike
fileProperty' :: forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
writemode Line
desc c -> c
a Line
f = forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc forall a b. (a -> b) -> a -> b
$ Bool -> Propellor Result
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Line -> IO Bool
doesFileExist Line
f)
where
go :: Bool -> Propellor Result
go Bool
True = do
c
old <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall c. FileContent c => Line -> IO c
readFileContent Line
f
let new :: c
new = c -> c
a c
old
if c
old forall a. Eq a => a -> a -> Bool
== c
new
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ c -> Line -> IO ()
updatefile c
new forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
go Bool
False = IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ Line -> c -> IO ()
writer Line
f (c -> c
a forall c. FileContent c => c
emptyFileContent)
updatefile :: c -> Line -> IO ()
updatefile c
content Line
dest = do
Line -> c -> IO ()
writer Line
dest c
content
FileStatus
s <- Line -> IO FileStatus
getFileStatus Line
f
Line -> FileMode -> IO ()
setFileMode Line
dest (FileStatus -> FileMode
fileMode FileStatus
s)
Line -> UserID -> GroupID -> IO ()
setOwnerAndGroup Line
dest (FileStatus -> UserID
fileOwner FileStatus
s) (FileStatus -> GroupID
fileGroup FileStatus
s)
writer :: Line -> c -> IO ()
writer = forall c. FileContent c => FileWriteMode -> Line -> c -> IO ()
writeFileContent FileWriteMode
writemode
stableTmpFor :: FilePath -> FilePath
stableTmpFor :: Line -> Line
stableTmpFor Line
f = Line
f forall a. [a] -> [a] -> [a]
++ Line
".propellor-new~"
viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()
viaStableTmp :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
viaStableTmp Line -> m ()
a Line
f = forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO Line
setup Line -> IO (Either IOException ())
cleanup Line -> m ()
go
where
setup :: IO Line
setup = do
Bool -> Line -> IO ()
createDirectoryIfMissing Bool
True (Line -> Line
takeDirectory Line
f)
let tmpfile :: Line
tmpfile = Line -> Line
stableTmpFor Line
f
Line -> IO ()
nukeFile Line
tmpfile
forall (m :: * -> *) a. Monad m => a -> m a
return Line
tmpfile
cleanup :: Line -> IO (Either IOException ())
cleanup Line
tmpfile = forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Line -> IO ()
removeFile Line
tmpfile
go :: Line -> m ()
go Line
tmpfile = do
Line -> m ()
a Line
tmpfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
rename Line
tmpfile Line
f
configFileName :: String -> FilePath
configFileName :: Line -> Line
configFileName = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> Line
escape
where
escape :: Char -> Line
escape Char
c
| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c = [Char
c]
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' = [Char
c]
| Bool
otherwise = Char
'_' forall a. a -> [a] -> [a]
: forall a. Show a => a -> Line
show (Char -> Int
ord Char
c)
showConfigFileName :: Show v => v -> FilePath
showConfigFileName :: forall a. Show a => a -> Line
showConfigFileName = Line -> Line
configFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Line
show
readConfigFileName :: Read v => FilePath -> Maybe v
readConfigFileName :: forall v. Read v => Line -> Maybe v
readConfigFileName = forall v. Read v => Line -> Maybe v
readish forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Line
unescape
where
unescape :: Line -> Line
unescape [] = []
unescape (Char
'_':Line
cs) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) Line
cs of
([], Line
_) -> Char
'_' forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs
(Line
ns, Line
cs') -> case forall v. Read v => Line -> Maybe v
readish Line
ns of
Maybe Int
Nothing -> Char
'_' forall a. a -> [a] -> [a]
: Line
ns forall a. [a] -> [a] -> [a]
++ Line -> Line
unescape Line
cs'
Just Int
n -> Int -> Char
chr Int
n forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs'
unescape (Char
c:Line
cs) = Char
c forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs
data Overwrite = OverwriteExisting | PreserveExisting
checkOverwrite :: Overwrite -> FilePath -> (FilePath -> Property i) -> Property i
checkOverwrite :: forall i. Overwrite -> Line -> (Line -> Property i) -> Property i
checkOverwrite Overwrite
OverwriteExisting Line
f Line -> Property i
mkp = Line -> Property i
mkp Line
f
checkOverwrite Overwrite
PreserveExisting Line
f Line -> Property i
mkp =
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesFileExist Line
f) (Line -> Property i
mkp Line
f)