module System.Locale.Read
(getLocale
,getCurrentLocale
,parseLocale
,TimeLocale(..)
,LocaleParseException(..)
) where
import Control.Exception
import Data.Time.Format (TimeLocale(..))
import System.Process
import Text.Megaparsec
import Text.Megaparsec.String
data LocaleParseException =
LocaleParseException (ParseError Char Dec)
deriving (Show,Eq)
instance Exception LocaleParseException
parseLocale :: Parser TimeLocale
parseLocale =
do abDay <- parseSemicolonSeparatedLine
day <- parseSemicolonSeparatedLine
abMon <- parseSemicolonSeparatedLine
mon <- parseSemicolonSeparatedLine
[am,pm] <- parseSemicolonSeparatedLine
dateTimeFmt' <- manyTill anyChar newline
dateFmt' <- manyTill anyChar newline
timeFmt' <- manyTill anyChar newline
time12Fmt' <- manyTill anyChar newline
pure (TimeLocale (zip day abDay)
(zip mon abMon)
(am,pm)
dateTimeFmt'
dateFmt'
timeFmt'
time12Fmt'
[])
getLocale :: Maybe String -> IO TimeLocale
getLocale localeName =
do output <-
readCreateProcess (getLocaleProcess localeName)
""
case runParser parseLocale "" output of
Left err -> throwIO (LocaleParseException err)
Right locale -> pure locale
getCurrentLocale :: IO TimeLocale
getCurrentLocale = getLocale Nothing
getLocaleProcess :: Maybe String -> CreateProcess
getLocaleProcess localeName =
(proc "locale"
["abday"
,"day"
,"abmon"
,"mon"
,"am_pm"
,"d_t_fmt"
,"d_fmt"
,"t_fmt"
,"t_fmt_ampm"]) {env = toLangEnv <$> localeName}
parseSemicolonSeparatedLine :: Parser [String]
parseSemicolonSeparatedLine =
sepBy (many (noneOf [';','\n']))
(char ';') <*
newline
toLangEnv :: String -> [(String,String)]
toLangEnv s = [("LC_TIME",s)]