-- | 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
[Char]
locale selectedFor :: [Char] -> [[Char]] -> RevertableProperty DebianLike DebianLike
`selectedFor` [[Char]]
vars = Property DebianLike
select forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
deselect
  where
	select :: Property DebianLike
select = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ 
		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
<$> IO Bool
isselected) 
			([Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"update-locale" [[Char]]
selectArgs)
			forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> RevertableProperty DebianLike DebianLike
available [Char]
locale
			forall p. IsProp p => p -> [Char] -> p
`describe` ([Char]
locale forall a. [a] -> [a] -> [a]
++ [Char]
" locale selected")
	deselect :: Property DebianLike
deselect = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
		forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
isselected ([Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"update-locale" [[Char]]
vars)
			forall p. IsProp p => p -> [Char] -> p
`describe` ([Char]
locale forall a. [a] -> [a] -> [a]
++ [Char]
" locale deselected")
	selectArgs :: [[Char]]
selectArgs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) [[Char]]
vars (forall a. a -> [a]
repeat (Char
'='forall a. a -> [a] -> [a]
:[Char]
locale))
	isselected :: IO Bool
isselected = [Char]
locale [Char] -> [[Char]] -> IO Bool
`isSelectedFor` [[Char]]
vars

isSelectedFor :: Locale -> [LocaleVariable] -> IO Bool
[Char]
locale isSelectedFor :: [Char] -> [[Char]] -> IO Bool
`isSelectedFor` [[Char]]
vars = do
	[[Char]]
ls <- forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO [] forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
"/etc/default/locale"
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
v -> [Char]
v forall a. [a] -> [a] -> [a]
++ [Char]
"=" forall a. [a] -> [a] -> [a]
++ [Char]
locale forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
ls) [[Char]]
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 :: [Char] -> RevertableProperty DebianLike DebianLike
available [Char]
locale = Property DebianLike
ensureAvailable forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [[Char]] -> Property DebianLike
Apt.installed [[Char]
"locales"]
	forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
ensureUnavailable
  where
	f :: [Char]
f = [Char]
"/etc/locale.gen"
	desc :: [Char]
desc = ([Char]
locale forall a. [a] -> [a] -> [a]
++ [Char]
" locale generated")
	ensureAvailable :: Property DebianLike
	ensureAvailable :: Property DebianLike
ensureAvailable = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' [Char]
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		[[Char]]
locales <- [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
readFile [Char]
f)
		if [Char]
locale forall {t :: * -> *}. Foldable t => [Char] -> t [Char] -> Bool
`presentIn` [[Char]]
locales
			then forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
				forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty [Char]
desc (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> [[Char]] -> [[Char]]
uncomment []) [Char]
f
					forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
regenerate
			else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"locale " forall a. [a] -> [a] -> [a]
++ [Char]
locale forall a. [a] -> [a] -> [a]
++ [Char]
" is not present in /etc/locale.gen, even in commented out form; cannot generate"
	ensureUnavailable :: Property DebianLike
	ensureUnavailable :: Property DebianLike
ensureUnavailable = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ 
		forall c.
(FileContent c, Eq c) =>
[Char] -> (c -> c) -> [Char] -> Property UnixLike
fileProperty ([Char]
locale forall a. [a] -> [a] -> [a]
++ [Char]
" locale not generated") (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> [[Char]] -> [[Char]]
comment []) [Char]
f
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property UnixLike
regenerate

	uncomment :: [Char] -> [[Char]] -> [[Char]]
uncomment [Char]
l [[Char]]
ls =
		if ([Char]
"# " forall a. [a] -> [a] -> [a]
++ [Char]
locale) forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l
		then forall a. Int -> [a] -> [a]
drop Int
2 [Char]
l forall a. a -> [a] -> [a]
: [[Char]]
ls
		else [Char]
lforall a. a -> [a] -> [a]
:[[Char]]
ls
	comment :: [Char] -> [[Char]] -> [[Char]]
comment [Char]
l [[Char]]
ls =
		if [Char]
locale forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l
		then ([Char]
"# " forall a. [a] -> [a] -> [a]
++ [Char]
l) forall a. a -> [a] -> [a]
: [[Char]]
ls
		else [Char]
lforall a. a -> [a] -> [a]
:[[Char]]
ls

	[Char]
l presentIn :: [Char] -> t [Char] -> Bool
`presentIn` t [Char]
ls = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char]
l [Char] -> [Char] -> Bool
`isPrefix`) t [Char]
ls
	[Char]
l isPrefix :: [Char] -> [Char] -> Bool
`isPrefix` [Char]
x = ([Char]
l forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x) Bool -> Bool -> Bool
|| (([Char]
"# " forall a. [a] -> [a] -> [a]
++ [Char]
l) forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x)

	regenerate :: Property UnixLike
regenerate = [Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"locale-gen" []
		forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange