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