    -- | 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 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 (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    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)
    			([Char] -> [[Char]] -> UncheckedProperty UnixLike
    cmdProperty [Char]
    "update-locale" [[Char]]
    selectArgs)
    			Property UnixLike
    -> RevertableProperty DebianLike DebianLike
    -> CombinedType
         (Property UnixLike) (RevertableProperty DebianLike DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` [Char] -> RevertableProperty DebianLike DebianLike
    available [Char]
    locale
    			Property DebianLike -> [Char] -> Property DebianLike
    forall p. IsProp p => p -> [Char] -> p
    `describe` ([Char]
    locale [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " locale selected")
    	deselect :: Property DebianLike
    deselect = Property UnixLike -> Property DebianLike
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    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 ([Char] -> [[Char]] -> UncheckedProperty UnixLike
    cmdProperty [Char]
    "update-locale" [[Char]]
    vars)
    			Property UnixLike -> [Char] -> Property UnixLike
    forall p. IsProp p => p -> [Char] -> p
    `describe` ([Char]
    locale [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " locale deselected")
    	selectArgs :: [[Char]]
    selectArgs = ([Char] -> [Char] -> [Char]) -> [[Char]] -> [[Char]] -> [[Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    (++) [[Char]]
    vars ([Char] -> [[Char]]
    forall a. a -> [a]
    repeat (Char
    '='Char -> [Char] -> [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 <- [[Char]] -> IO [[Char]] -> IO [[Char]]
    forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO [] (IO [[Char]] -> IO [[Char]]) -> IO [[Char]] -> IO [[Char]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]]
    lines ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO [Char]
    readFile [Char]
    "/etc/default/locale"
    	Bool -> IO Bool
    forall a. a -> IO a
    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
    $ ([Char] -> Bool) -> [[Char]] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[Char]
    v -> [Char]
    v [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    locale [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` [[Char]] -> Property DebianLike
    Apt.installed [[Char]
    "locales"]
    	Property DebianLike
    -> Property DebianLike -> RevertableProperty DebianLike DebianLike
    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 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " locale generated")
    	ensureAvailable :: Property DebianLike
    	ensureAvailable :: Property DebianLike
    ensureAvailable = [Char]
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    [Char]
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' [Char]
    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
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    		[[Char]]
    locales <- [Char] -> [[Char]]
    lines ([Char] -> [[Char]]) -> Propellor [Char] -> Propellor [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO [Char] -> Propellor [Char]
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Char] -> Propellor [Char]) -> IO [Char] -> Propellor [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO [Char]
    readFile [Char]
    f)
    		if [Char]
    locale [Char] -> [[Char]] -> Bool
    forall {t :: * -> *}. Foldable t => [Char] -> t [Char] -> Bool
    `presentIn` [[Char]]
    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
    $
    				[Char] -> ([[Char]] -> [[Char]]) -> [Char] -> Property UnixLike
    forall c.
    (FileContent c, Eq c) =>
    [Char] -> (c -> c) -> [Char] -> Property UnixLike
    fileProperty [Char]
    desc (([Char] -> [[Char]] -> [[Char]])
    -> [[Char]] -> [[Char]] -> [[Char]]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr [Char] -> [[Char]] -> [[Char]]
    uncomment []) [Char]
    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 [Char] -> Propellor Result
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Propellor Result) -> [Char] -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "locale " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    locale [Char] -> [Char] -> [Char]
    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 = Property UnixLike -> Property DebianLike
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    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
    $
    		[Char] -> ([[Char]] -> [[Char]]) -> [Char] -> Property UnixLike
    forall c.
    (FileContent c, Eq c) =>
    [Char] -> (c -> c) -> [Char] -> Property UnixLike
    fileProperty ([Char]
    locale [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " locale not generated") (([Char] -> [[Char]] -> [[Char]])
    -> [[Char]] -> [[Char]] -> [[Char]]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr [Char] -> [[Char]] -> [[Char]]
    comment []) [Char]
    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 :: [Char] -> [[Char]] -> [[Char]]
    uncomment [Char]
    l [[Char]]
    ls =
    		if ([Char]
    "# " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    locale) [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    l
    		then Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    2 [Char]
    l [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    ls
    		else [Char]
    l[Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :[[Char]]
    ls
    	comment :: [Char] -> [[Char]] -> [[Char]]
    comment [Char]
    l [[Char]]
    ls =
    		if [Char]
    locale [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    l
    		then ([Char]
    "# " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    l) [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    ls
    		else [Char]
    l[Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :[[Char]]
    ls

    	[Char]
    l presentIn :: [Char] -> t [Char] -> Bool
    `presentIn` t [Char]
    ls = ([Char] -> Bool) -> t [Char] -> Bool
    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 [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    x) Bool -> Bool -> Bool
    || (([Char]
    "# " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    l) [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    x)

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