diff --git a/hgettext.cabal b/hgettext.cabal --- a/hgettext.cabal +++ b/hgettext.cabal @@ -1,5 +1,5 @@ Name: hgettext -Version: 0.1.5 +Version: 0.1.6 Cabal-Version: >= 1.6 License: BSD3 @@ -19,7 +19,7 @@ Hs-Source-Dirs: src Build-Depends: base, process, directory, filepath, - containers, Cabal + containers, Cabal, setlocale Executable hgettext Main-Is: hgettext.hs diff --git a/src/Distribution/Simple/I18N/GetText.hs b/src/Distribution/Simple/I18N/GetText.hs --- a/src/Distribution/Simple/I18N/GetText.hs +++ b/src/Distribution/Simple/I18N/GetText.hs @@ -84,10 +84,9 @@ import Language.Haskell.Extension -import Data.Map (findWithDefault, fromList) import Control.Monad import Control.Arrow (second) -import Data.Maybe (listToMaybe, maybeToList) +import Data.Maybe (listToMaybe, maybeToList, fromMaybe) import Data.List (unfoldr,nub,null) import System.FilePath import System.Directory @@ -187,7 +186,7 @@ getCustomFields = customFieldsPD . localPkgDescr findInParametersDefault :: [(String, String)] -> String -> String -> String -findInParametersDefault al name def = findWithDefault def name $ fromList al +findInParametersDefault al name def = (fromMaybe def . lookup name) al getDomainNameDefault :: [(String, String)] -> String -> String getDomainNameDefault al d = findInParametersDefault al "x-gettext-domain-name" d diff --git a/src/Text/I18N/GetText.hs b/src/Text/I18N/GetText.hs --- a/src/Text/I18N/GetText.hs +++ b/src/Text/I18N/GetText.hs @@ -2,6 +2,11 @@ module Text.I18N.GetText ( getText, + nGetText, + dGetText, + dnGetText, + dcGetText, + dcnGetText, bindTextDomain, textDomain ) where @@ -10,12 +15,33 @@ import Foreign.C.String import Foreign.Ptr import Data.Maybe (fromMaybe) +import System.Locale.SetLocale -foreign import ccall unsafe "libintl.h gettext" c_gettext :: CString -> IO CString -foreign import ccall unsafe "libintl.h bindtextdomain" c_bindtextdomain :: - CString -> CString -> IO CString -foreign import ccall unsafe "libintl.h textdomain" c_textdomain :: CString -> IO CString +foreign import ccall unsafe "libintl.h gettext" c_gettext + :: CString -> IO CString + +foreign import ccall unsafe "libintl.h dgettext" c_dgettext + :: CString -> CString -> IO CString + +foreign import ccall unsafe "libintl.h dcgettext" c_dcgettext + :: CString -> CString -> CInt -> IO CString + +foreign import ccall unsafe "libintl.h ngettext" c_ngettext + :: CString -> CString -> CULong -> IO CString + +foreign import ccall unsafe "libintl.h dngettext" c_dngettext + :: CString -> CString -> CString -> CULong -> IO CString + +foreign import ccall unsafe "libintl.h dcngettext" c_dcngettext + :: CString -> CString -> CString -> CULong -> CInt -> IO CString + +foreign import ccall unsafe "libintl.h bindtextdomain" c_bindtextdomain + :: CString -> CString -> IO CString + +foreign import ccall unsafe "libintl.h textdomain" c_textdomain + :: CString -> IO CString + fromCString :: CString -> IO (Maybe String) fromCString x | x == nullPtr = return Nothing | otherwise = peekCString x >>= return . Just @@ -23,6 +49,16 @@ fromCStringDefault :: String -> CString -> IO String fromCStringDefault d x = fromCString x >>= \r -> return (fromMaybe d r) +fromCStringPluralDefault :: Num a => String -> String -> a -> CString -> IO String +fromCStringPluralDefault def def_plural n s + | n == 1 = fromCStringDefault def s + | otherwise = fromCStringDefault def_plural s + + +withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a +withCStringMaybe Nothing f = f nullPtr +withCStringMaybe (Just str) f = withCString str f + -- |getText wraps GNU gettext function. It returns translated string for the -- input messages. If translated string not found the input string will be -- returned. @@ -40,25 +76,101 @@ withCString s $ \s' -> c_gettext s' >>= fromCStringDefault s +-- |dGetText wraps GNU dgettext function. It works similar to 'getText' +-- but also could take domain name. +-- +dGetText :: Maybe String -- ^ domain name, if 'Nothing' --- + -- default domain will be used + -> String -- ^ message id + -> IO String -- ^ return value +dGetText domainname msgid = + withCStringMaybe domainname $ \dn' -> + withCString msgid $ \msg' -> + c_dgettext dn' msg' >>= fromCStringDefault msgid + +-- |dcGetText wraps GNU dcgettext function. It works similar to 'dGetText' +-- but also takes category id +dcGetText :: Maybe String -- ^ domain name, if 'Nothing' --- + -- default domain will be used + -> Category -- ^ locale facet + -> String -- ^ message id + -> IO String -- ^ return value +dcGetText domainname cat msgid = + withCStringMaybe domainname $ \dn' -> + withCString msgid $ \msg' -> + c_dcgettext dn' msg' (categoryToCInt cat) >>= + fromCStringDefault msgid + +-- |nGetText wraps GNU ngettext function. It translates text string in the +-- user's native language, by lookilng up the approppiate plural form of the +-- message. +-- +nGetText :: String -- ^ msgid in singular form + -> String -- ^ msgid in plural form + -> Integer -- ^ number, used to choose appropriate form + -> IO String -- ^ result string, by default if number is 1 than + -- singular form of msgid is returned, otherwise --- + -- plural +nGetText msgid msgid_plural n = + withCString msgid $ \msgid' -> + withCString msgid_plural $ \msgid_plural' -> + c_ngettext msgid' msgid_plural' (fromInteger n) >>= + fromCStringPluralDefault msgid msgid_plural n + +-- |dnGetText wraps GNU dngettext function. It works similar to 'nGetText' but +-- also takes domain name +-- +dnGetText :: Maybe String -- ^ domain name, if 'Nothing' --- + -- default domain will be used + -> String -- ^ msgid in singular form + -> String -- ^ msgid in plural form + -> Integer -- ^ number, used to choose appropriate form + -> IO String -- ^ result string, by default if number is 1 than + -- singular form of msgid is returned, otherwise --- + -- plural +dnGetText domainname msgid msgid_plural n = + withCStringMaybe domainname $ \dn' -> + withCString msgid $ \msgid' -> + withCString msgid_plural $ \msgid_plural' -> + c_dngettext dn' msgid' msgid_plural' (fromInteger n) >>= + fromCStringPluralDefault msgid msgid_plural n + +-- |dcnGetText wraps GNU dcngettext function. It works similar to 'dnGetText' but +-- also takes category id +-- +dcnGetText :: Maybe String -- ^ domain name, if 'Nothing' --- + -- default domain will be used + -> Category -- ^ locale facet + -> String -- ^ msgid in singular form + -> String -- ^ msgid in plural form + -> Integer -- ^ number, used to choose appropriate form + -> IO String -- ^ result string, by default if number is 1 than + -- singular form of msgid is returned, otherwise --- + -- plural +dcnGetText domainname cat msgid msgid_plural n = + withCStringMaybe domainname $ \dn' -> + withCString msgid $ \msgid' -> + withCString msgid_plural $ \msgid_plural' -> + c_dcngettext dn' msgid' msgid_plural' + (fromInteger n) (categoryToCInt cat) >>= + fromCStringPluralDefault msgid msgid_plural n + -- |bindTextDomain sets the base directory of the hierarchy -- containing message catalogs for a given message domain. -- bindTextDomain :: String -- ^ domain name - -> Maybe String -- ^ path to the locale folder or Nothing if - -- standard domain is used + -> Maybe String -- ^ path to the locale folder or 'Nothing' to return + -- base directory for domain -> IO (Maybe String) -- ^ return value -bindTextDomain domainname (Just dirname) = +bindTextDomain domainname dirname = withCString domainname $ \domain -> - withCString dirname $ \dir -> + withCStringMaybe dirname $ \dir -> c_bindtextdomain domain dir >>= fromCString -bindTextDomain domainname Nothing = - withCString domainname $ \domain -> - c_bindtextdomain domain nullPtr >>= fromCString - -- |textDomain sets domain for future 'getText' call -textDomain :: String -- ^ domain name +textDomain :: Maybe String -- ^ domain name, if 'Nothing' than returns + -- current domain name -> IO (Maybe String) -- ^ return value textDomain domainname = - withCString domainname $ \domain -> + withCStringMaybe domainname $ \domain -> c_textdomain domain >>= fromCString