packages feed

localize (empty) → 0.2.0.0

raw patch · 10 files changed

+598/−0 lines, 10 filesdep +Globdep +basedep +binarysetup-changed

Dependencies added: Glob, base, binary, bytestring, containers, data-default, directory, filepath, haskell-gettext, mtl, setlocale, text, text-format-heavy, time, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, IlyaPortnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of IlyaPortnov nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,29 @@+localize README+===============++This package is more or less fully functional translation framework,+based on [haskell-gettext][1] package. The key features are:++* Convinient functions for translation.+* Full support of gettext features, such as message contexts and plural forms.+* It is possible to detect language to use by process locale. But it is not+  necessary, you for example may want to use `Accept-Language` HTTP header+  instead.+* Easy integration with custom monadic stacks by implementing instance of+  `Localized` type class.+* There are two simple implementations of `Localized` type class, for IO and+  StateT-based monad transformer. Being mostly examples, these implementations+  can be useful in relatively simple applications.+* Utility functions to locate catalog files by specified rules. Example rules+  for locating catalog files under source directory and for locating them+  under usual Linux locations are provided.+* Integration with [text-format-heavy][2] package. It may be more convinient+  than use of some other formatting libraries (`printf`, for example),+  since it supports named variable placeholders, much easier for translators+  to understand.++Please refer to Haddock documentation and to examples in `examples/` directory.++[1]: https://hackage.haskell.org/package/haskell-gettext+[2]: https://hackage.haskell.org/package/text-format-heavy+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Localize.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, DeriveDataTypeable #-}+-- | This is the main module of the @localize@ package.+-- It contains definitions of general use and reexport generally required internal modules.+module Text.Localize+  (+   -- $description+   --+   -- * Most used functions+   __, __n, __f,+   -- * Basic functions+   translate, translateN, translateNFormat, +   lookup, withTranslation,+   -- * Reexports+   module Text.Localize.Types,+   module Text.Localize.Load,+   module Text.Localize.Locale+  ) where++import Prelude hiding (lookup)+import Control.Applicative+import Control.Monad+import qualified Data.Map as M+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Data.Text.Encoding as TE+import Data.String+import Data.List hiding (lookup)+import Data.Monoid+import Data.Typeable+import qualified Data.Gettext as Gettext+import qualified Data.Text.Format.Heavy as F+import Data.Text.Format.Heavy.Parse (parseFormat)++import Text.Localize.Types+import Text.Localize.Load+import Text.Localize.Locale++-- $description+--+-- This is the main module of the @localize@ package. In most cases, you have to import only+-- this module. In specific cases, you may also want to import Text.Localize.IO or Text.Localize.State.+--+-- All functions exported by @localize@ package work with any instance of the+-- @Localized@ type class. There are two simple examples of this type class+-- implementation provided in separate modules (IO and State); however, in+-- complex applications it may be more convinient to implement @Localized@+-- instance for the monadic stack you already have.+--+-- Example of usage is:+--+-- @+-- import qualified Data.Text as T+-- import qualified Data.Text.Lazy.IO as TLIO+-- import Text.Localize+-- +-- newtype MyMonad a = MyMonad {unMyMonad :: ... }+--   deriving (Monad)+-- +-- instance Localized MyMonad where+--   ...+--+-- runMyMonad :: Translations -> MyMonad a -> IO a+-- runMyMonad = ...+-- +-- hello :: T.Text -> MyMonad ()+-- hello name = do+--   liftIO $ TLIO.putStrLn =<< __ "Your name: "+--   liftIO $ hFlush stdout+--   name <- liftIO $ TLIO.getLine+--   greeting <- __f "Hello, {}!" (Single name)+--   liftIO $ TLIO.putStrLn greeting+--+-- main :: IO ()+-- main = do+--   translations <- locateTranslations $ linuxLocation "hello"+--   runMyMonad translations hello+--+-- @+--+-- See also working examples under @examples/@ directory.+--++-- | Look up for translation. Returns source string if translation not found.+lookup :: Translations -> LanguageId -> TranslationSource -> T.Text+lookup t lang bstr =+  case M.lookup lang (tMap t) of+    Nothing -> toText bstr+    Just gmo -> Gettext.gettext gmo bstr++-- | Execute function depending on current translation catalog and context.+withTranslation :: Localized m+                => (b -> r)    -- ^ Function to be executed if there is no+                               --   translation for current language loaded.+                -> (Gettext.Catalog -> Maybe Context -> b -> r) -- ^ Function to be executed on current catalog.+                -> (b -> m r)  -- ^ Function lifted into @Localized@ monad.+withTranslation dflt fn b = do+  t <- getTranslations+  lang <- getLanguage+  ctxt <- getContext+  case M.lookup lang (tMap t) of+    Nothing -> return $ dflt b+    Just gmo -> return $ fn gmo ctxt b++-- | Translate a string.+translate :: (Localized m) => TranslationSource -> m T.Text+translate orig = do+  t <- getTranslations+  lang <- getLanguage+  mbContext <- getContext+  case M.lookup lang (tMap t) of+    Nothing -> return $ toText orig+    Just gmo ->+      case mbContext of+        Nothing -> return $ Gettext.gettext gmo orig+        Just ctxt -> return $ Gettext.cgettext gmo ctxt orig++-- | Short alias for @translate@.+__ ::  (Localized m) => TranslationSource -> m T.Text+__ = translate++-- | Translate a string, taking plural forms into account.+translateN :: (Localized m)+           => TranslationSource -- ^ Single form in original language+           -> TranslationSource -- ^ Plural form in original language+           -> Int               -- ^ Number+           -> m T.Text+translateN orig plural n = do+  t <- getTranslations+  lang <- getLanguage+  mbContext <- getContext+  case M.lookup lang (tMap t) of+    Nothing -> return $ toText orig+    Just gmo ->+      case mbContext of+        Nothing -> return $ Gettext.ngettext gmo orig plural n+        Just ctxt -> return $ Gettext.cngettext gmo ctxt orig plural n++-- | Translate a string and substitute variables into it.+-- Data.Text.Format.Heavy.format syntax is used.+translateFormat :: (Localized m, F.VarContainer vars)+                => TranslationSource -- ^ Original formatting string+                -> vars              -- ^ Substitution variables+                -> m T.Text+translateFormat orig vars = do+  fmtStr <- translate orig+  case parseFormat fmtStr of+    Left err -> fail $ show err+    Right fmt -> return $ F.format fmt vars++-- | Short alias for @translateFormat@.+__f ::  (Localized m, F.VarContainer c) => TranslationSource -> c -> m T.Text+__f = translateFormat++-- | Translate a string, taking plural forms into account,+-- and substitute variables into it.+-- Data.Text.Format.Heavy.format syntax is used.+translateNFormat :: (Localized m, F.VarContainer vars)+                 => TranslationSource -- ^ Single form of formatting string in original language+                 -> TranslationSource -- ^ Plural form of formatting string in original language+                 -> Int               -- ^ Number+                 -> vars              -- ^ Substitution variables+                 -> m T.Text+translateNFormat orig plural n vars = do+  fmtStr <- translateN orig plural n+  case parseFormat fmtStr of+    Left err -> fail $ show err+    Right fmt -> return $ F.format fmt vars++-- | Short alias for @translateNFormat@.+__n :: (Localized m, F.VarContainer c) => TranslationSource -> TranslationSource -> Int -> c -> m T.Text+__n = translateNFormat+
+ Text/Localize/IO.hs view
@@ -0,0 +1,76 @@+-- | This module is most near to be a drop-in replacement for @hgettext@ API.+-- It provides an @instance Localized IO@ by using process-level global variables (IORefs) for+-- storing current language and translations.+--+-- Being mostly an example, this module can though be usable for relatively simple applications,+-- for which you do not need to change languages a lot.+module Text.Localize.IO+  (setupTranslations,+   setLanguage, withLanguage,+   setContext, withContext+  ) where++import Data.IORef+import System.IO.Unsafe (unsafePerformIO)++import Text.Localize.Types+import Text.Localize.Load+import Text.Localize.Locale++currentContext :: IORef (Maybe Context)+currentContext = unsafePerformIO $ newIORef Nothing+{-# NOINLINE currentContext #-}++currentLanguage :: IORef LanguageId+currentLanguage = unsafePerformIO $ do+    language <- languageFromLocale+    newIORef language+{-# NOINLINE currentLanguage #-}++currentTranslations :: IORef Translations+currentTranslations = unsafePerformIO $ newIORef undefined+{-# NOINLINE currentTranslations #-}++instance Localized IO where+  getLanguage = readIORef currentLanguage+  getTranslations = readIORef currentTranslations+  getContext = readIORef currentContext++-- | This function must be called before any translation function call,+-- otherwise you will get runtime error.+--+-- Current language is selected from process locale at startup. You can+-- change it later by calling @setLanguage@ or @withLanguage@.+setupTranslations :: LocatePolicy -> IO ()+setupTranslations p = do+  translations <- locateTranslations p+  writeIORef currentTranslations translations++-- | Set current language.+setLanguage :: LanguageId -> IO ()+setLanguage language = writeIORef currentLanguage language++-- | Execute some actions with specific language, and+-- then return to previously used language.+withLanguage :: LanguageId -> IO a -> IO a+withLanguage language actions = do+  oldLang <- getLanguage+  setLanguage language+  result <- actions+  setLanguage oldLang+  return result++-- | Set current context.+setContext :: Maybe Context -> IO ()+setContext mbContext = writeIORef currentContext mbContext++-- | Execute some actions within specific context,+-- and then return to previously used context.+withContext :: Maybe Context -> IO a -> IO a+withContext ctxt actions = do+  oldContext <- getContext+  setContext ctxt+  result <- actions+  setContext oldContext+  return result+
+ Text/Localize/Load.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, DeriveDataTypeable, OverloadedStrings, RecordWildCards #-}+-- | This module contains definitions for loading translation catalogs.+module Text.Localize.Load+  ( -- * Data types+    LocatePolicy (..), Facet,+    -- * Main functions+    loadTranslations, locateTranslations,+    -- * Commonly used location policies+    linuxLocation, localLocation+  ) where++import Control.Monad+import Control.Monad.Trans+import Data.Default+import qualified Data.Map as M+import qualified Data.Text.Lazy as T+import qualified Data.Gettext as Gettext+import Data.Text.Format.Heavy+import System.Directory+import System.FilePath+import System.FilePath.Glob++import Text.Localize.Types++-- | Load translations when path to each translation file is known.+loadTranslations :: [(LanguageId, FilePath)] -> IO Translations+loadTranslations pairs = do+  res <- forM pairs $ \(lang, path) -> do+           gmo <- Gettext.loadCatalog path+           return (lang, gmo)+  return $ Translations $ M.fromList res++-- | Locale facet (@LC_MESSAGES@ and siblings).+type Facet = String++-- | This data type defines where to search for catalog files (@.mo@ or @.gmo@) in the file system.+data LocatePolicy = LocatePolicy {+    lcBasePaths :: [FilePath] -- ^ Paths to directory with translations, e.g. @"\/usr\/share\/locale"@. Defaults to @"locale"@.+  , lcName :: String       -- ^ Catalog file name (in gettext this is also known as text domain). Defaults to @"messages"@.+  , lcFacet :: Facet       -- ^ Locale facet. Defaults to @LC_MESSAGES@.+  , lcFormat :: Format     -- ^ File path format. The following variables can be used:+                           -- +                           -- * @{base}@ - path to directory with translations;+                           -- * @{language}@ - language code;+                           -- * @{facet}@ - locale facet;+                           -- * @{name}@ - file name (text domain), without extension.+                           --+                           -- Please note: assumption is made that the @{language}@ variable is used only once.+                           --+                           --  Defaults to @"{base}\/{language}\/{facet}\/{name}.mo"@.+  }+  deriving (Show)++instance Default LocatePolicy where+  def = LocatePolicy {+          lcBasePaths = ["locale"],+          lcName = "messages",+          lcFacet = "LC_MESSAGES",+          lcFormat = "{base}/{language}/{facet}/{name}.mo"+        }++-- | Usual Linux translations location policy.+-- Catalog files are found under @\/usr\/[local\/]share\/locale\/{language}\/LC_MESSAGES\/{name}.mo@.+linuxLocation :: String        -- ^ Catalog file name (text domain)+              -> LocatePolicy+linuxLocation name = def {lcBasePaths = ["/usr/share/locale", "/usr/local/share/locale"], lcName = name}++-- | Simple translations location polciy, assuming all catalog files located at+-- @{base}\/{language}.mo@.+localLocation :: FilePath      -- ^ Path to directory with translations+              -> LocatePolicy+localLocation base = def {lcBasePaths = [base], lcFormat = "{base}/{language}.mo"}++-- | Locate and load translations according to specified policy.+locateTranslations :: MonadIO m => LocatePolicy -> m Translations+locateTranslations (LocatePolicy {..}) = liftIO $ do+    basePaths <- mapM makeAbsolute lcBasePaths+    pairs <- forM basePaths $ \basePath -> do+        let vars = M.fromList $+                     [("base", basePath),+                      ("language", "*"),+                      ("facet", lcFacet),+                      ("name", lcName)] :: M.Map T.Text String+            Format fmtItems = lcFormat+            (fmtBase, fmtTail) = breakFormat fmtItems+            pathGlob = T.unpack (format lcFormat vars)+            pathBaseLen = fromIntegral $ T.length (format (Format fmtBase) vars)+            pathTailLen = fromIntegral $ T.length (format (Format fmtTail) vars)+        paths <- glob pathGlob+        forM paths $ \path -> do+             let pathWithoutBase = drop pathBaseLen path+                 languageLen = length pathWithoutBase - pathTailLen+                 language = take languageLen pathWithoutBase+             return (language, path)+    loadTranslations $ concat pairs+  where+    breakFormat items =+      let (hd, tl) = break isLanguage items+      in  case tl of+            [] -> (hd, [])+            _  -> (hd, tail tl)++    isLanguage (FVariable name _) = name == "language"+    isLanguage _ = False+
+ Text/Localize/Locale.hs view
@@ -0,0 +1,17 @@+-- | This module contains definitions related to+-- obtaining current localization settings from+-- process's locale.+module Text.Localize.Locale where++import Data.Maybe+import System.Locale.SetLocale++import Text.Localize.Types++-- | Obtain language to be used from process's locale.+languageFromLocale :: IO LanguageId+languageFromLocale = do+  mbLocale <- setLocale LC_MESSAGES (Just "")+  let locale = fromMaybe "C" mbLocale+  return $ takeWhile (/= '_') locale+
+ Text/Localize/State.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TypeSynonymInstances, GeneralizedNewtypeDeriving, OverloadedStrings #-}+-- | This module offers a simple implementation of @Localized@ class via @StateT@ transformer.+-- This implementation is usable if you have nothing against adding yet another transformer to+-- your already complicated monadic stack. Otherwise, it may be simpler for you to add necessary+-- fields to one of @StateT@s or @ReaderT@s in your stack.+module Text.Localize.State+  (-- * Data types+   LocState (..),+   LocalizeT (..),+   -- * Functions+   runLocalizeT,+   setLanguage, withLanguage,+   setContext, withContext+  ) where++import Control.Applicative+import Control.Monad.State+import Control.Monad.Trans++import Text.Localize.Types++-- | Localization state+data LocState = LocState {+    lsTranslations :: Translations, +    lsLanguage :: LanguageId,+    lsContext :: Maybe Context+  }+  deriving (Show)++-- | Localization monad transformer+newtype LocalizeT m a = LocalizeT {+    unLocalizeT :: StateT LocState m a+  }+  deriving (Functor, Applicative, Monad, MonadIO, MonadState LocState)++instance Monad m => Localized (LocalizeT m) where+  getTranslations = gets lsTranslations+  getLanguage = gets lsLanguage+  getContext = gets lsContext++-- | Run a computation inside @LocalizeT@.+runLocalizeT :: Monad m => LocalizeT m a -> LocState -> m a+runLocalizeT actions st = evalStateT (unLocalizeT actions) st++-- | Set current language+setLanguage :: Monad m => LanguageId -> LocalizeT m ()+setLanguage lang = modify $ \st -> st {lsLanguage = lang}++-- | Execute some actions with specified language.+withLanguage :: Monad m => LanguageId -> LocalizeT m a -> LocalizeT m a+withLanguage lang actions = do+  oldLang <- gets lsLanguage+  setLanguage lang+  result <- actions+  setLanguage oldLang+  return result++-- | Set current context.+setContext :: Monad m => Maybe Context -> LocalizeT m ()+setContext ctxt = modify $ \st -> st {lsContext = ctxt}++-- | Execute some actions within specific context.+withContext :: Monad m => Maybe Context -> LocalizeT m a -> LocalizeT m a+withContext ctxt actions = do+  oldContext <- gets lsContext+  setContext ctxt+  result <- actions+  setContext oldContext+  return result+
+ Text/Localize/Types.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, DeriveDataTypeable #-}+-- | This module contains data type definitions for the @localize@ package.+module Text.Localize.Types where++import Control.Applicative+import qualified Data.Map as M+import qualified Data.ByteString as B+import qualified Data.Text.Lazy as T+import qualified Data.Text.Encoding as TE+import qualified Data.Gettext as Gettext++-- | Language identifier+type LanguageId = String++-- | Context name+type Context = B.ByteString++-- | String to be translated+type TranslationSource = B.ByteString++-- | Stores translation catalogs for all supported languages+data Translations = Translations {+  tMap :: M.Map LanguageId Gettext.Catalog }++instance Show Translations where+  show t = "<Translations to languages: " ++ (unwords $ M.keys $ tMap t) ++ ">"++-- | This is the main type class of the package.+-- All functions work with any instance of this type class.+-- +-- Note that this class only supports **getting** current language+-- and translation, not setting them. Though concrete implementation+-- can have its own ways to change language or context, these ways are+-- not required by the @localize@ package, and so are not declared in the+-- type class.+class (Monad m, Applicative m) => Localized m where+  -- | Obtain currently selected language ID.+  getLanguage :: m LanguageId+  +  -- | Obtain currently loaded translations.+  getTranslations :: m Translations++  -- | Obtain currently selected localization context.+  -- Nothing means no specific context.+  getContext :: m (Maybe Context)+  getContext = return Nothing++-- | This assumes UTF-8 encoding.+toText :: TranslationSource -> T.Text+toText bstr = T.fromStrict $ TE.decodeUtf8 bstr+
+ localize.cabal view
@@ -0,0 +1,44 @@+name:                localize+version:             0.2.0.0+synopsis:            GNU Gettext-based messages localization library+description:         More or less fully functional translation framework,+                     based on @haskell-gettext@ and @text-format-heavy@+                     packages.+license:             BSD3+license-file:        LICENSE+author:              IlyaPortnov+maintainer:          portnov84@rambler.ru+-- copyright:           +category:            Text+build-type:          Simple+extra-doc-files:     README.md+cabal-version:       >=1.18++library+  exposed-modules:     Text.Localize,+                       Text.Localize.Types,+                       Text.Localize.Load,+                       Text.Localize.State,+                       Text.Localize.IO,+                       Text.Localize.Locale+  build-depends:       base > 4 && < 5,+                       mtl >= 2.2.1,+                       binary >=0.7,+                       bytestring ==0.10.*,+                       text >= 1.2,+                       data-default >= 0.7,+                       containers >=0.5,+                       text-format-heavy >= 0.1.4.0,+                       haskell-gettext >= 0.1.1.0,+                       time >=1.4,+                       transformers >=0.3,+                       filepath >= 1.4,+                       directory >= 1.3,+                       Glob >= 0.7.14,+                       setlocale >= 1.0+  default-language:    Haskell2010++Source-repository head+  type: git+  location: https://github.com/portnov/localize.git+