-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>

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

-- | Select a locale for a list of global locale variables.
--
-- A locale variable is of the form @LC_BLAH@, @LANG@ or @LANGUAGE@.  See
-- @locale(5)@.  One might say
--
--  >  & "en_GB.UTF-8" `Locale.selectedFor` ["LC_PAPER", "LC_MONETARY"]
--
-- to select the British English locale for paper size and currency conventions.
--
-- Note that reverting this property does not make a locale unavailable.  That's
-- because it might be required for other Locale.selectedFor statements.
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
	

-- | Ensures a locale is generated (or, if reverted, ensure it's not).
--
-- Fails if a locale is not available to be generated.  That is, a commented out
-- entry for the locale and an accompanying charset must be present in
-- /etc/locale.gen.
--
-- Per Debian bug #684134 we cannot ensure a locale is generated by means of
-- Apt.reConfigure.  So localeAvailable edits /etc/locale.gen manually.
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