diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,12 @@ +0.1.40 +====== + +_Andreas Abel, 2022-09-04_ + +The `hgettext` tool can now parse Haskell files with: +(contributions by Nikola Hadžić) +- `LANGUAGE` extensions [#19](https://github.com/haskell-hvr/hgettext/issues/19) +- CPP directives [#21](https://github.com/haskell-hvr/hgettext/issues/21) + +Tested with GHC 7.4 - 8.6. +Requires `Cabal ≤ 2.2`, thus, does not build with GHC 8.8 and above. diff --git a/hgettext.cabal b/hgettext.cabal --- a/hgettext.cabal +++ b/hgettext.cabal @@ -1,16 +1,16 @@ cabal-version: 1.14 name: hgettext -version: 0.1.31.0 +version: 0.1.40 build-type: Simple license: BSD3 license-file: LICENSE -author: Vasyl Pasternak -maintainer: Herbert Valerio Riedel +author: Vasyl Pasternak, Herbert Valerio Riedel, Nikola Hadžić +maintainer: https://github.com/haskell-hvr/hgettext copyright: 2009 Vasyl Pasternak category: Text -bug-reports: https://github.com/hvr/hgettext/issues +bug-reports: https://github.com/haskell-hvr/hgettext/issues synopsis: Bindings to libintl.h (gettext, bindtextdomain) description: This package provides bindings to the @gettext@ internationalization and localization (i18n) library. . @@ -18,11 +18,28 @@ . A user-contributed tutorial can be found in the [Haskell Wiki](https://wiki.haskell.org/Internationalization_of_Haskell_programs_using_gettext). -tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +tested-with: + -- Constraint Cabal < 2.1 prevents building with GHC > 8.6 + -- GHC == 9.4.2 + -- GHC == 9.2.4 + -- GHC == 9.0.2 + -- GHC == 8.10.7 + -- GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 + GHC == 7.6.3 + GHC == 7.4.2 +extra-source-files: + CHANGELOG.md + source-repository head type: git - location: https://github.com/hvr/hgettext.git + location: https://github.com/haskell-hvr/hgettext.git library default-language: Haskell2010 @@ -31,9 +48,10 @@ other-modules: Internal hs-source-dirs: src - build-depends: base >=4.5 && <4.11 - , Cabal >=1.14 && <1.25 || == 2.0.* - , containers >=0.4.2 && <0.6 + build-depends: base >=4.5 && <4.13 + , Cabal >=1.14 && <1.25 || >= 2.0 && < 2.3 + -- Cabal >= 2.4 fails on matchGlobFile + , containers >=0.4.2 && <0.7 , directory >=1.1 && <1.4 , filepath >=1.3 && <1.5 , process >=1.1 && <1.7 @@ -60,8 +78,12 @@ , containers , filepath - build-depends: deepseq >=1.1 && <1.5 - , haskell-src-exts >=1.18 && <1.21 - , uniplate >=1.6.12 && <1.7 + build-depends: deepseq >=1.1 && <1.5 + , cpphs >=1.20.9.1 && <1.20.10 + , haskell-src-exts >=1.18 && <1.24 + , uniplate >=1.6.12 && <1.7 + , split >=0.2.3.4 && <0.2.4 + , extra >=0.1 && <1.8 + -- readFileUTF8 exists since extra-0.1 ghc-options: -Wall diff --git a/src-exe/hgettext.hs b/src-exe/hgettext.hs --- a/src-exe/hgettext.hs +++ b/src-exe/hgettext.hs @@ -4,19 +4,26 @@ import Control.Exception import Control.Monad import Data.Generics.Uniplate.Data +import Data.List.Split (splitOn) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Version (showVersion) +import Language.Preprocessor.Cpphs as C import qualified Language.Haskell.Exts as H import System.Console.GetOpt import System.Environment import System.Exit +import System.IO (IOMode(WriteMode), hPutStr, hSetEncoding, utf8, withFile) +import System.IO.Extra (readFileUTF8) import Paths_hgettext (version) data Options = Options { outputFile :: FilePath , keyword :: String + , extensions :: [H.Extension] + , cpp :: Bool + , cpp_defs :: [(String, String)] , printVersion :: Bool } deriving Show @@ -31,13 +38,22 @@ , Option ['k'] ["keyword"] (ReqArg (\d opts -> opts {keyword = d}) "WORD") "function name, in which wrapped searched words" + , Option ['e'] ["lang-exts"] + (ReqArg (\es opts -> opts {extensions = map (\e -> H.parseExtension e) (splitOn "," es)}) "EXTENSION...") + "language extensions to enable/disable when parsing input (prefix \"No\" to an extension to disable it)" + , Option [] ["cpp"] + (NoArg (\opts -> opts {cpp = True})) + "do the C pre-processing" + , Option [] ["cpp-defs"] + (ReqArg (\defs opts -> opts {cpp_defs = map (\def -> let l = splitOn "=" def in (head l, last l)) (splitOn "," defs)}) "IDENTIFIER=VALUE...") + "C pre-processing defines list" , Option [] ["version"] (NoArg (\opts -> opts {printVersion = True})) "print version of hgettexts" ] defaultOptions :: Options -defaultOptions = Options "messages.po" "__" False +defaultOptions = Options "messages.po" "__" [] False [] False parseArgs :: [String] -> IO (Options, [String]) parseArgs args = @@ -57,10 +73,18 @@ <- universeBi z :: [H.Exp H.SrcSpanInfo] , x == f] +showStringLit :: String -> String +showStringLit s0 = '"' : concatMap showChar s0 ++ "\"" + where + showChar '"' = "\\\"" + showChar '\\' = "\\\\" + showChar '\n' = "\\n" + showChar c = return c + formatMessage :: String -> [(FilePath, Int)] -> String formatMessage s locs = unlines $ map (uncurry formatLoc) locs ++ - [ "msgid " ++ (show s) + [ "msgid " ++ (showStringLit s) , "msgstr \"\"" , "" ] @@ -86,6 +110,12 @@ "\"Content-Transfer-Encoding: 8bit\\n\"", ""] +writeFileUtf8 :: FilePath -> String -> IO () +writeFileUtf8 fp content = + withFile fp WriteMode $ \h -> do + hSetEncoding h utf8 + hPutStr h content + process :: Options -> [FilePath] -> IO () process Options{printVersion = True} _ = putStrLn $ "hgettext, version " ++ (showVersion version) @@ -96,21 +126,15 @@ let entries = Map.fromListWith Set.union [ (s,Set.singleton (fn,loc)) | d <- dat, (s,(fn,loc)) <- d ] - writeFile (outputFile opts) $ do + writeFileUtf8 (outputFile opts) $ do writePOTFile [ formatMessage s (Set.toList locs) | (s,locs) <- Map.toList entries ] where - readSource "-" = do - c <- getContents - case H.parseFileContents c of - H.ParseFailed loc msg -> do - putStrLn (concat [ ":", show (H.srcLine loc), ":", show (H.srcColumn loc), ": error: ", msg ]) - exitFailure - H.ParseOk m -> return m readSource f = do - pm <- H.parseFile f - case pm of + let rf = if f == "-" then "" else f + c <- (if f == "-" then getContents else readFileUTF8 f) >>= if cpp opts then C.runCpphs (C.defaultCpphsOptions {C.defines = cpp_defs opts}) rf else return + case H.parseFileContentsWithMode (H.defaultParseMode {H.parseFilename = rf, H.extensions = extensions opts}) c of H.ParseFailed loc msg -> do - putStrLn (concat [ f, ":", show (H.srcLine loc), ":", show (H.srcColumn loc), ": error: ", msg ]) + putStrLn (concat [ rf, ":", show (H.srcLine loc), ":", show (H.srcColumn loc), ": error: ", msg ]) exitFailure H.ParseOk m -> return m