    -- | 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