cli/Hcompta/CLI/Context.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 module Hcompta.CLI.Context where
   4
   5 import           Control.Monad (liftM)
   6 import qualified Data.List
   7 import           Data.Maybe (catMaybes)
   8 import qualified Data.Text as Text
   9 import           Data.Text (Text)
  10 import           System.Environment (getEnvironment)
  11 import           System.IO.Memoize (once)
  12
  13 data App = App
  14
  15 data Context
  16  =   Context
  17  { verbosity :: Verbosity
  18  , command   :: String
  19  , color     :: Maybe Bool
  20  , langs     :: [Text]
  21  } deriving (Show)
  22
  23 context :: IO Context
  24 context = do
  25         langs <- get_langs
  26         return $
  27                 Context
  28                  { verbosity = Verbosity_Info
  29                  , command   = ""
  30                  , color     = Nothing
  31                  , langs
  32                  }
  33
  34 data Verbosity
  35  = Verbosity_Error
  36  | Verbosity_Warn
  37  | Verbosity_Info
  38  | Verbosity_Debug
  39  deriving (Bounded, Enum, Eq, Ord, Show)
  40
  41 -- TODO: check that this is expected behavior
  42 --       and portability issues
  43 get_langs :: IO [Text]
  44 get_langs = do
  45         once getEnvironment
  46         >>= liftM (\env ->
  47                 Data.List.concatMap
  48                  ( map Text.pack
  49                  . (\lang ->
  50                         let short = takeWhile ('_' /=) lang in
  51                         if short == lang
  52                         then [lang]
  53                         else [lang, short])
  54                  . Data.List.takeWhile (\c -> c /= '.') ) $
  55                 catMaybes
  56                  [ Data.List.lookup "LC_ALL"   env
  57                  , Data.List.lookup "LC_CTYPE" env
  58                  , Data.List.lookup "LANG"     env
  59                  , Just "en"
  60                  ])