summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/System/Localize.hsc
blob: 84c4d4571c8c0719c528c026305e39b5b319abe6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Localize
-- Copyright   :  (C) 2011, 2018 Martin Perner
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Martin Perner <martin@perner.cc>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module provides an interface to locale information e.g. for DateL
--
-----------------------------------------------------------------------------

module Xmobar.System.Localize
    ( setupTimeLocale,
      getTimeLocale
    ) where

import Foreign.C
#if ! MIN_VERSION_time(1,5,0)
import qualified System.Locale as L
#else
import qualified Data.Time.Format as L
#endif

import Codec.Binary.UTF8.String

--  get localized strings
type NlItem = CInt

#include <langinfo.h>
foreign import ccall unsafe "langinfo.h nl_langinfo"
  nl_langinfo :: NlItem -> IO CString

#{enum NlItem,
  , AM_STR , PM_STR \
  , D_T_FMT , D_FMT , T_FMT , T_FMT_AMPM \
  , ABDAY_1, ABDAY_7 \
  , DAY_1, DAY_7 \
  , ABMON_1, ABMON_12 \
  , MON_1, MON_12\
 }

getLangInfo :: NlItem -> IO String
getLangInfo item = do
  itemStr <- nl_langinfo item
  str <- peekCString itemStr
  return $ if isUTF8Encoded str then decodeString str else str

#include <locale.h>
foreign import ccall unsafe "locale.h setlocale"
    setlocale :: CInt -> CString -> IO CString

setupTimeLocale :: String -> IO ()
setupTimeLocale l = withCString l (setlocale #const LC_TIME) >> return ()

getTimeLocale :: IO L.TimeLocale
getTimeLocale = do
  -- assumes that the defined values are increasing by exactly one.
  -- as they are defined consecutive in an enum this is reasonable
  days   <- mapM getLangInfo [day1 .. day7]
  abdays <- mapM getLangInfo [abday1 .. abday7]

  mons   <- mapM getLangInfo [mon1 .. mon12]
  abmons <- mapM getLangInfo [abmon1 .. abmon12]

  amstr <- getLangInfo amStr
  pmstr <- getLangInfo pmStr
  dtfmt <- getLangInfo dTFmt
  dfmt  <- getLangInfo dFmt
  tfmt  <- getLangInfo tFmt
  tfmta <- getLangInfo tFmtAmpm

  let t =  L.defaultTimeLocale {L.wDays  = zip days abdays
                               ,L.months = zip mons abmons
                               ,L.amPm = (amstr, pmstr)
                               ,L.dateTimeFmt = dtfmt
                               ,L.dateFmt = dfmt
                               ,L.timeFmt = tfmt
                               ,L.time12Fmt = tfmta}
  return t