gettext-th 0.1.0.3 → 0.2.0.0

raw patch · 3 files changed

+59/−26 lines, 3 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• gettext-th.cabal +3/−2
• src/I18N/Gettext/TH.hs +51/−24

@@ -1,5 +1,10 @@ # Revision history for gettext-th +## 0.2.0.0++* duplicates are filtered out+* utf8 support+ ## 0.1.0.0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               gettext-th-version:            0.1.0.3+version:            0.2.0.0  synopsis: gettext-th can internationalise a haskell program without runtime dependencies @@ -17,7 +17,7 @@  -- A copyright notice. -- copyright:-category: i18n Text+category: i18n, Text extra-source-files: CHANGELOG.md, README.md  library@@ -30,6 +30,7 @@     -- other-extensions:     build-depends:    base  >= 4 && < 5                     , bytestring+                    , containers                     , directory                     , filepath                     , haskell-gettext

@@ -4,6 +4,8 @@  import Language.Haskell.TH import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax+ import Instances.TH.Lift() import System.IO.Unsafe import System.Directory@@ -12,6 +14,8 @@ import Data.Bifunctor import Data.Char (isSpace) import Data.List+import Data.Set (Set)+import qualified Data.Set as S  import qualified Data.ByteString as B import qualified Data.Text as T@@ -21,11 +25,11 @@ import qualified Data.Gettext as G import Data.Gettext (Catalog, loadCatalog) import System.FilePath.Posix-+import System.IO -{-# NOINLINE firstCall #-}-firstCall :: IORef Bool-firstCall = unsafePerformIO $ newIORef True+{-# NOINLINE knownMsgs #-}+knownMsgs :: IORef (Set String)+knownMsgs = unsafePerformIO $ newIORef S.empty  potFileName :: FilePath potFileName = "po/messages.pot"@@ -61,57 +65,80 @@   "\"Language-Team: LANGUAGE <LL@li.org>\\n\"",   "\"Language: \\n\"",   "\"MIME-Version: 1.0\\n\"",-  "\"Content-Type: text/plain; charset=CHARSET\\n\"",+  "\"Content-Type: text/plain; charset=utf-8\\n\"",   "\"Content-Transfer-Encoding: 8bit\\n\""   ] ++++writeFileUtf8 :: FilePath -> IOMode -> String -> IO ()+writeFileUtf8 f mode txt = withFile f mode (\ hdl -> do+                                               hSetEncoding hdl utf8+                                               hPutStr hdl txt)  + createPotFile :: Q () createPotFile = do-  runIO $ do-    f <- readIORef firstCall-    when f $ do-      writeIORef firstCall False+  fn <- runIO $ do       createDirectoryIfMissing True (takeDirectory potFileName)       potE <- doesFileExist potFileName           when potE $         renameFile potFileName (potFileName ++ ".bak") -      writeFile potFileName header-    --addDependentFile poFileName+      writeFileUtf8 potFileName WriteMode header+      makeAbsolute moFileName+  addDependentFile fn   packStr :: String -> B.ByteString packStr = encodeUtf8 . T.pack - gettextQ  :: String -> Q Exp gettextQ str = do-  createPotFile-  loc <- location-  runIO $ appendFile potFileName $ unlines $ poEntry loc str+  kmsgs <- runIO $ do+     kmsgs <- readIORef knownMsgs+     writeIORef knownMsgs (S.insert str kmsgs)+     return kmsgs++  when (S.null kmsgs) createPotFile+  when (str `S.notMember` kmsgs) $ do+    loc <- location+    runIO $ writeFileUtf8 potFileName AppendMode $ unlines $ poEntry loc str   let trans = TL.toStrict $ G.gettext catalog (packStr str)   [| trans |] +quote :: String -> String+quote s =  '"':escape s+  where escape [] = "\""+        escape ('"':s') = '\\':'"':escape s'+        escape ('\n':s') = '\\':'n':escape s'+        escape ('\r':s') = escape s'+        escape (c:s') = c:escape s'+          poEntry :: Loc -> String -> [String] poEntry loc msg = [       "",       "#: " ++ (loc_filename loc) ++ ":0", -- TODO line nr or char pos-      "msgid " ++ show msg,-      "msgstr " ++ show msg +      "msgid " ++ quote msg,+      "msgstr " ++ quote msg        ]  gettextsDecs  :: String -> Q [Dec] gettextsDecs str = do-  createPotFile-  loc <- location   let msgs = map splitKeyMsg $ parseLines str  -  runIO $ appendFile potFileName $ unlines $ concat [ poEntry loc msg | (_, msg) <- msgs ]    +  kmsgs <- runIO $ do+     kmsgs <- readIORef knownMsgs+     writeIORef knownMsgs (foldl' (\ acc (_, msg) -> msg `S.insert` acc) kmsgs msgs)+     return kmsgs+  when (S.null kmsgs) createPotFile+  loc <- location +  runIO $ writeFileUtf8 potFileName AppendMode $ unlines $ concat [ poEntry loc msg | (_, msg) <- msgs, msg `S.notMember` kmsgs ]    +   forM msgs $ \ (key, msg) ->               let trans = TL.toStrict $ G.gettext catalog (packStr msg) in do-                 e <-  [| trans |]-                 return $ FunD (mkName key) [Clause [] (NormalB e) []]+                 funD (mkName key) [clause [] (normalB [| trans |]) []]                             @@ -132,7 +159,7 @@          join acc cl = (intercalate "\n" $ reverse cl):acc  splitKeyMsg :: String -> (String, String)        -splitKeyMsg line =  bimap trim (trim . tail)$ span (/= ':') line +splitKeyMsg line =  bimap trim (trim . tail) $ span (/= ':') line      trim :: String -> String@@ -143,7 +170,7 @@ gettext :: QuasiQuoter gettext = QuasiQuoter   { quoteExp  = gettextQ-  , quotePat  = error "Usage as a parttern is not supported"+  , quotePat  = error "Usage as a pattern is not supported"   , quoteType = error "Usage as a type is not supported"   , quoteDec = gettextsDecs   }