{-# 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 = Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty
(Line
"replace " Line -> Line -> Line
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 = Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" contains:" Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ [Line] -> Line
forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
go Line
f
where
go :: [Line] -> [Line]
go [Line]
content = [Line]
content [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ (Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
filter (Line -> [Line] -> Bool
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 =
Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" contains block:" Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ [Line] -> Line
forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
add Line
f
Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" lacks block:" Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ [Line] -> Line
forall a. Show a => a -> Line
show [Line]
ls) [Line] -> [Line]
remove Line
f
where
add :: [Line] -> [Line]
add [Line]
content
| [Line]
ls [Line] -> [Line] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Line]
content = [Line]
content
| Bool
otherwise = [Line]
content [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
ls
remove :: [Line] -> [Line]
remove [] = []
remove content :: [Line]
content@(Line
x:[Line]
xs)
| [Line]
ls [Line] -> [Line] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Line]
content = [Line] -> [Line]
remove (Int -> [Line] -> [Line]
forall a. Int -> [a] -> [a]
drop ([Line] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Line]
ls) [Line]
content)
| Bool
otherwise = Line
x Line -> [Line] -> [Line]
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 = Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" remove: " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
l) ((Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
filter (Line -> Line -> Bool
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 = Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" remove: " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ [[Line]] -> Line
forall a. Show a => a -> Line
show [[Line]
ls]) ((Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
filter (Line -> [Line] -> Bool
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 = FileWriteMode
-> Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
fileProperty' FileWriteMode
ProtectedWrite
(Line
"replace " Line -> Line -> Line
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 = PrivDataSource -> Line -> c -> Property (HasInfo + UnixLike)
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 = FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
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 = PrivDataSource -> Line -> c -> Property (HasInfo + UnixLike)
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 = FileWriteMode -> s -> Line -> c -> Property (HasInfo + UnixLike)
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 =
s
-> c
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property (HasInfo + UnixLike))
-> Property (HasInfo + UnixLike)
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 ((((PrivData -> Propellor Result) -> Propellor Result)
-> Property (HasInfo + UnixLike))
-> Property (HasInfo + UnixLike))
-> (((PrivData -> Propellor Result) -> Propellor Result)
-> Property (HasInfo + UnixLike))
-> Property (HasInfo + UnixLike)
forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getcontent ->
Line
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc ((OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> (OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> (PrivData -> Propellor Result) -> Propellor Result
getcontent ((PrivData -> Propellor Result) -> Propellor Result)
-> (PrivData -> Propellor Result) -> Propellor Result
forall a b. (a -> b) -> a -> b
$ \PrivData
privcontent ->
OuterMetaTypesWitness
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> Propellor Result
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 (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FileWriteMode
-> Line -> (ByteString -> ByteString) -> Line -> Property UnixLike
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 " Line -> Line -> Line
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) = Line
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Line
desc ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike)
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
o -> do
Line
tmpl <- IO Line -> Propellor Line
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Line -> Propellor Line) -> IO Line -> Propellor Line
forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readFile Line
src
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> Propellor Result
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 (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Line -> ([Line] -> [Line]) -> Line -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Line -> (c -> c) -> Line -> Property UnixLike
fileProperty Line
desc (\[Line]
_ -> [Line] -> [Line]
a ([Line] -> [Line]) -> [Line] -> [Line]
forall a b. (a -> b) -> a -> b
$ Line -> [Line]
lines (Line -> [Line]) -> Line -> [Line]
forall a b. (a -> b) -> a -> b
$ Line
tmpl) Line
f
where
desc :: Line
desc = Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" is based on " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
src
notPresent :: FilePath -> Property UnixLike
notPresent :: Line -> Property UnixLike
notPresent Line
f = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Line -> IO Bool
doesFileExist Line
f) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" not present") (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Line -> IO ()
nukeFile Line
f
dirExists :: FilePath -> Property UnixLike
dirExists :: Line -> Property UnixLike
dirExists Line
d = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesDirectoryExist Line
d) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
d Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" exists") (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
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 Property UnixLike
-> Property UnixLike -> RevertableProperty UnixLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
notLinked
where
linked :: Property UnixLike
linked = Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" is symlinked to " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
target) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
Either IOException FileStatus -> Propellor Result
forall {a}. Either a FileStatus -> Propellor Result
go (Either IOException FileStatus -> Propellor Result)
-> Propellor (Either IOException FileStatus) -> Propellor Result
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 (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
createSymbolicLink Line
target Line
link
notLinked :: Property UnixLike
notLinked = Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
link Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
"does not exist as a symlink") (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
Either IOException FileStatus -> Propellor Result
forall {a}. Either a FileStatus -> Propellor Result
stop (Either IOException FileStatus -> Propellor Result)
-> Propellor (Either IOException FileStatus) -> Propellor Result
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 (IO () -> Propellor Result) -> IO () -> Propellor Result
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
Line -> Propellor ()
forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (Line -> Propellor ()) -> Line -> Propellor ()
forall a b. (a -> b) -> a -> b
$ Line
link Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" exists and is not a symlink"
Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
checkLink :: Propellor Result
checkLink = do
Line
target' <- IO Line -> Propellor Line
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Line -> Propellor Line) -> IO Line -> Propellor Line
forall a b. (a -> b) -> a -> b
$ Line -> IO Line
readSymbolicLink Line
link
if Line
target Line -> Line -> Bool
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 (Line -> IO ()) -> Line -> IO ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
link
getLinkStatus :: Propellor (Either IOException FileStatus)
getLinkStatus = IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus)
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus))
-> IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ IO FileStatus -> IO (Either IOException FileStatus)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO FileStatus -> IO (Either IOException FileStatus))
-> IO FileStatus -> IO (Either IOException FileStatus)
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 = Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Either IOException FileStatus -> Propellor Result
forall {a}. Show a => Either a FileStatus -> Propellor Result
go (Either IOException FileStatus -> Propellor Result)
-> Propellor (Either IOException FileStatus) -> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus)
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus))
-> IO (Either IOException FileStatus)
-> Propellor (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ IO FileStatus -> IO (Either IOException FileStatus)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO FileStatus -> IO (Either IOException FileStatus))
-> IO FileStatus -> IO (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ Line -> IO FileStatus
getFileStatus Line
src)
where
desc :: Line
desc = Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" is copy of " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
src
go :: Either a FileStatus -> Propellor Result
go (Right FileStatus
stat) = if FileStatus -> Bool
isRegularFile FileStatus
stat
then Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (IO Bool -> Propellor Bool
forall a. IO a -> Propellor a
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
$ Line -> IO Bool
doesFileExist Line
f)
( ExitCode -> Propellor Result
gocmp (ExitCode -> Propellor Result)
-> Propellor ExitCode -> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO ExitCode -> Propellor ExitCode
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> Propellor ExitCode)
-> IO ExitCode -> Propellor ExitCode
forall a b. (a -> b) -> a -> b
$ IO ExitCode
cmp)
, Propellor Result
doit
)
else Line -> Propellor ()
forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (Line
src Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" is not a regular file") Propellor () -> Propellor Result -> Propellor Result
forall a b. Propellor a -> Propellor b -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
go (Left a
e) = Line -> Propellor ()
forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage (a -> Line
forall a. Show a => a -> Line
show a
e) Propellor () -> Propellor Result -> Propellor Result
forall a b. Propellor a -> Propellor b -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> Propellor Result
forall a. a -> Propellor a
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
_ = Line -> Propellor ()
forall (m :: * -> *). MonadIO m => Line -> m ()
warningMessage Line
"cmp failed" Propellor () -> Propellor Result -> Propellor Result
forall a b. Propellor a -> Propellor b -> Propellor b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
doit :: Propellor Result
doit = IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Line -> IO ()
copy (Line -> IO ()) -> Line -> IO ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
copy :: Line -> IO ()
copy Line
dest = IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (Line -> IO Bool
runcp Line
dest) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Line -> IO ()
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 Property UnixLike -> Line -> Property UnixLike
forall p. IsProp p => p -> Line -> p
`describe` (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" owner " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
og)
where
p :: Property UnixLike
p = Line -> [Line] -> UncheckedProperty UnixLike
cmdProperty Line
"chown" [Line
og, Line
f]
UncheckedProperty UnixLike -> Line -> Property UnixLike
forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
og :: Line
og = Line
owner Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
":" Line -> Line -> 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 = [Property metatypes] -> Property metatypes
forall a. Monoid a => [a] -> a
mconcat ([Property metatypes] -> Property metatypes)
-> [Property metatypes] -> Property metatypes
forall a b. (a -> b) -> a -> b
$
(Line -> Property metatypes) -> [Line] -> [Property metatypes]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Property metatypes
mkp ((Line -> Line -> Line) -> Line -> [Line] -> [Line]
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 Property UnixLike -> Line -> Property UnixLike
forall (p :: * -> *) i. Checkable p i => p i -> Line -> Property i
`changesFile` Line
f
where
p :: Property UnixLike
p = Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property (Line
f Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line
" mode " Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ FileMode -> Line
forall a. Show a => a -> Line
show FileMode
v) (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ Line -> (FileMode -> FileMode) -> IO ()
modifyFileMode Line
f (FileMode -> FileMode -> FileMode
forall a b. a -> b -> a
const FileMode
v)
Result -> Propellor Result
forall a. a -> Propellor a
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 (Line -> [Line]) -> IO Line -> IO [Line]
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 = FileWriteMode -> Line -> (c -> c) -> Line -> Property UnixLike
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 = Line -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
Line -> Propellor Result -> Property (MetaTypes metatypes)
property Line
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Bool -> Propellor Result
go (Bool -> Propellor Result) -> Propellor Bool -> Propellor Result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool -> Propellor Bool
forall a. IO a -> Propellor a
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 <- IO c -> Propellor c
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> Propellor c) -> IO c -> Propellor c
forall a b. (a -> b) -> a -> b
$ Line -> IO c
forall c. FileContent c => Line -> IO c
readFileContent Line
f
let new :: c
new = c -> c
a c
old
if c
old c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
new
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ c -> Line -> IO ()
updatefile c
new (Line -> IO ()) -> Line -> IO ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(Line -> m ()) -> Line -> m ()
`viaStableTmp` Line
f
go Bool
False = IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Line -> c -> IO ()
writer Line
f (c -> c
a c
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 = FileWriteMode -> Line -> c -> IO ()
forall c. FileContent c => FileWriteMode -> Line -> c -> IO ()
writeFileContent FileWriteMode
writemode
stableTmpFor :: FilePath -> FilePath
stableTmpFor :: Line -> Line
stableTmpFor Line
f = Line
f Line -> Line -> Line
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 = IO Line
-> (Line -> IO (Either IOException ())) -> (Line -> m ()) -> m ()
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
Line -> IO Line
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Line
tmpfile
cleanup :: Line -> IO (Either IOException ())
cleanup Line
tmpfile = IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Line -> IO ()
removeFile Line
tmpfile
go :: Line -> m ()
go Line
tmpfile = do
Line -> m ()
a Line
tmpfile
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Line -> Line -> IO ()
rename Line
tmpfile Line
f
configFileName :: String -> FilePath
configFileName :: Line -> Line
configFileName = (Char -> Line) -> Line -> Line
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = [Char
c]
| Bool
otherwise = Char
'_' Char -> Line -> Line
forall a. a -> [a] -> [a]
: Int -> Line
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 (Line -> Line) -> (v -> Line) -> v -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Line
forall a. Show a => a -> Line
show
readConfigFileName :: Read v => FilePath -> Maybe v
readConfigFileName :: forall v. Read v => Line -> Maybe v
readConfigFileName = Line -> Maybe v
forall v. Read v => Line -> Maybe v
readish (Line -> Maybe v) -> (Line -> Line) -> Line -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Line
unescape
where
unescape :: Line -> Line
unescape [] = []
unescape (Char
'_':Line
cs) = case (Char -> Bool) -> Line -> (Line, Line)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) Line
cs of
([], Line
_) -> Char
'_' Char -> Line -> Line
forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs
(Line
ns, Line
cs') -> case Line -> Maybe Int
forall v. Read v => Line -> Maybe v
readish Line
ns of
Maybe Int
Nothing -> Char
'_' Char -> Line -> Line
forall a. a -> [a] -> [a]
: Line
ns Line -> Line -> Line
forall a. [a] -> [a] -> [a]
++ Line -> Line
unescape Line
cs'
Just Int
n -> Int -> Char
chr Int
n Char -> Line -> Line
forall a. a -> [a] -> [a]
: Line -> Line
unescape Line
cs'
unescape (Char
c:Line
cs) = Char
c Char -> Line -> Line
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 =
IO Bool -> Property i -> Property i
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> IO Bool
doesFileExist Line
f) (Line -> Property i
mkp Line
f)