module Propellor.Property.Locale where
import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import Data.List (isPrefixOf)
type Locale = String
type LocaleVariable = String
selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty DebianLike DebianLike
locale :: Locale
locale selectedFor :: Locale -> [Locale] -> RevertableProperty DebianLike DebianLike
`selectedFor` vars :: [Locale]
vars = Property DebianLike
select Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
deselect
where
select :: Property DebianLike
select = Property DebianLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
IO Bool -> UncheckedProperty 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
<$> IO Bool
isselected)
(Locale -> [Locale] -> UncheckedProperty UnixLike
cmdProperty "update-locale" [Locale]
selectArgs)
Property UnixLike
-> RevertableProperty DebianLike DebianLike
-> CombinedType
(Property UnixLike) (RevertableProperty DebianLike DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Locale -> RevertableProperty DebianLike DebianLike
available Locale
locale
Property DebianLike -> Locale -> Property DebianLike
forall p. IsProp p => p -> Locale -> p
`describe` (Locale
locale Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ " locale selected")
deselect :: Property DebianLike
deselect = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
isselected (Locale -> [Locale] -> UncheckedProperty UnixLike
cmdProperty "update-locale" [Locale]
vars)
Property UnixLike -> Locale -> Property UnixLike
forall p. IsProp p => p -> Locale -> p
`describe` (Locale
locale Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ " locale deselected")
selectArgs :: [Locale]
selectArgs = (Locale -> Locale -> Locale) -> [Locale] -> [Locale] -> [Locale]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
(++) [Locale]
vars (Locale -> [Locale]
forall a. a -> [a]
repeat ('='Char -> Locale -> Locale
forall a. a -> [a] -> [a]
:Locale
locale))
isselected :: IO Bool
isselected = Locale
locale Locale -> [Locale] -> IO Bool
`isSelectedFor` [Locale]
vars
isSelectedFor :: Locale -> [LocaleVariable] -> IO Bool
locale :: Locale
locale isSelectedFor :: Locale -> [Locale] -> IO Bool
`isSelectedFor` vars :: [Locale]
vars = do
[Locale]
ls <- [Locale] -> IO [Locale] -> IO [Locale]
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO [] (IO [Locale] -> IO [Locale]) -> IO [Locale] -> IO [Locale]
forall a b. (a -> b) -> a -> b
$ Locale -> [Locale]
lines (Locale -> [Locale]) -> IO Locale -> IO [Locale]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Locale -> IO Locale
readFile "/etc/default/locale"
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Locale -> Bool) -> [Locale] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\v :: Locale
v -> Locale
v Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ "=" Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ Locale
locale Locale -> [Locale] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Locale]
ls) [Locale]
vars
available :: Locale -> RevertableProperty DebianLike DebianLike
available :: Locale -> RevertableProperty DebianLike DebianLike
available locale :: Locale
locale = Property DebianLike
ensureAvailable Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Locale] -> Property DebianLike
Apt.installed ["locales"]
Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
ensureUnavailable
where
f :: Locale
f = "/etc/locale.gen"
desc :: Locale
desc = (Locale
locale Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ " locale generated")
ensureAvailable :: Property DebianLike
ensureAvailable :: Property DebianLike
ensureAvailable = Locale
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Locale
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Locale
desc ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike)
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \w :: OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
[Locale]
locales <- Locale -> [Locale]
lines (Locale -> [Locale]) -> Propellor Locale -> Propellor [Locale]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO Locale -> Propellor Locale
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Locale -> Propellor Locale) -> IO Locale -> Propellor Locale
forall a b. (a -> b) -> a -> b
$ Locale -> IO Locale
readFile Locale
f)
if Locale
locale Locale -> [Locale] -> Bool
forall (t :: * -> *). Foldable t => Locale -> t Locale -> Bool
`presentIn` [Locale]
locales
then OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> 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]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
Locale -> ([Locale] -> [Locale]) -> Locale -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Locale -> (c -> c) -> Locale -> Property UnixLike
fileProperty Locale
desc ((Locale -> [Locale] -> [Locale])
-> [Locale] -> [Locale] -> [Locale]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Locale -> [Locale] -> [Locale]
uncomment []) Locale
f
Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
regenerate
else Locale -> Propellor Result
forall a. HasCallStack => Locale -> a
error (Locale -> Propellor Result) -> Locale -> Propellor Result
forall a b. (a -> b) -> a -> b
$ "locale " Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ Locale
locale Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ " is not present in /etc/locale.gen, even in commented out form; cannot generate"
ensureUnavailable :: Property DebianLike
ensureUnavailable :: Property DebianLike
ensureUnavailable = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
Locale -> ([Locale] -> [Locale]) -> Locale -> Property UnixLike
forall c.
(FileContent c, Eq c) =>
Locale -> (c -> c) -> Locale -> Property UnixLike
fileProperty (Locale
locale Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ " locale not generated") ((Locale -> [Locale] -> [Locale])
-> [Locale] -> [Locale] -> [Locale]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Locale -> [Locale] -> [Locale]
comment []) Locale
f
Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
regenerate
uncomment :: Locale -> [Locale] -> [Locale]
uncomment l :: Locale
l ls :: [Locale]
ls =
if ("# " Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ Locale
locale) Locale -> Locale -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Locale
l
then Int -> Locale -> Locale
forall a. Int -> [a] -> [a]
drop 2 Locale
l Locale -> [Locale] -> [Locale]
forall a. a -> [a] -> [a]
: [Locale]
ls
else Locale
lLocale -> [Locale] -> [Locale]
forall a. a -> [a] -> [a]
:[Locale]
ls
comment :: Locale -> [Locale] -> [Locale]
comment l :: Locale
l ls :: [Locale]
ls =
if Locale
locale Locale -> Locale -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Locale
l
then ("# " Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ Locale
l) Locale -> [Locale] -> [Locale]
forall a. a -> [a] -> [a]
: [Locale]
ls
else Locale
lLocale -> [Locale] -> [Locale]
forall a. a -> [a] -> [a]
:[Locale]
ls
l :: Locale
l presentIn :: Locale -> t Locale -> Bool
`presentIn` ls :: t Locale
ls = (Locale -> Bool) -> t Locale -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Locale
l Locale -> Locale -> Bool
`isPrefix`) t Locale
ls
l :: Locale
l isPrefix :: Locale -> Locale -> Bool
`isPrefix` x :: Locale
x = (Locale
l Locale -> Locale -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Locale
x) Bool -> Bool -> Bool
|| (("# " Locale -> Locale -> Locale
forall a. [a] -> [a] -> [a]
++ Locale
l) Locale -> Locale -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Locale
x)
regenerate :: Property UnixLike
regenerate = Locale -> [Locale] -> UncheckedProperty UnixLike
cmdProperty "locale-gen" []
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange