Setup.hs 3.46 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
{-# OPTIONS_GHC -Wall #-}
3 4 5

#if defined(VERSION_hgettext)

6 7 8
import System.FilePath ( (</>), (<.>) )

import Distribution.PackageDescription
Will Thompson's avatar
Will Thompson committed
9
import Distribution.Simple
10
import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
11 12 13 14 15 16 17 18
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup as S
import Distribution.Simple.Utils
import Distribution.Text ( display )

import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName

19
import qualified GetText
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

main :: IO ()
main = defaultMainWithHooks $ installBustleHooks simpleUserHooks

-- Okay, so we want to use hgettext's install hook, but not the hook that
-- miraculously runs all our code through CPP just to add a couple of
-- constants. (cpp doesn't like multi-line Haskell strings, so this is not
-- purely an academic preference.)
--
-- Instead, we generate GetText_bustle.hs which contains the constants, in the
-- same way as Paths_bustle.hs gets generated by Cabal. Much neater.
--
-- TODO: upstream this to hgettext
installBustleHooks :: UserHooks
                   -> UserHooks
installBustleHooks uh = uh
36 37 38
  { postInst = \a b c d -> do
        postInst uh a b c d
        GetText.installPOFiles a b c d
39 40 41 42 43 44 45 46 47 48
  , buildHook = \pkg lbi hooks flags -> do
        writeGetTextConstantsFile pkg lbi flags
        buildHook uh pkg lbi hooks flags
  }


writeGetTextConstantsFile :: PackageDescription -> LocalBuildInfo -> BuildFlags -> IO ()
writeGetTextConstantsFile pkg lbi flags = do
    let verbosity = fromFlag (buildVerbosity flags)

49
    createDirectoryIfMissingVerbose verbosity True (autogenPackageModulesDir lbi)
50

51
    let pathsModulePath = autogenPackageModulesDir lbi
52
                      </> ModuleName.toFilePath (getTextConstantsModuleName pkg) <.> "hs"
53
    rewriteFileEx verbosity pathsModulePath (generateModule pkg lbi)
54 55 56 57

getTextConstantsModuleName :: PackageDescription -> ModuleName
getTextConstantsModuleName pkg_descr =
  ModuleName.fromString $
58 59 60 61 62
    "GetText_" ++ fixedPackageName pkg_descr

-- Cargo-culted from two separate places in Cabal!
fixedPackageName :: PackageDescription -> String
fixedPackageName = map fixchar . display . packageName
63 64 65 66 67 68 69 70 71 72 73 74 75 76
  where fixchar '-' = '_'
        fixchar c   = c

generateModule :: PackageDescription -> LocalBuildInfo -> String
generateModule pkg lbi =
    header ++ body
  where
    moduleName = getTextConstantsModuleName pkg

    header =
        "module " ++ display moduleName ++ " (\n"++
        "    getMessageCatalogDomain,\n" ++
        "    getMessageCatalogDir\n" ++
        ") where\n"++
77 78 79
        "\n" ++
        "import qualified Control.Exception as Exception\n" ++
        "import System.Environment (getEnv)\n"
80 81

    body =
82 83 84
        "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n" ++
        "catchIO = Exception.catch\n" ++
        "\n" ++
85 86 87
        "getMessageCatalogDomain :: IO String\n" ++
        "getMessageCatalogDomain = return " ++ show dom ++ "\n" ++
        "\n" ++
88 89 90
        "messageCatalogDir :: String\n" ++
        "messageCatalogDir = " ++ show tar ++ "\n" ++
        "\n" ++
91
        "getMessageCatalogDir :: IO FilePath\n" ++
92
        "getMessageCatalogDir = catchIO (getEnv \"" ++ fixedPackageName pkg ++ "_localedir\") (\\_ -> return messageCatalogDir)\n"
93 94

    sMap = customFieldsPD (localPkgDescr lbi)
95 96
    dom = GetText.getDomainNameDefault sMap (GetText.getPackageName lbi)
    tar = GetText.targetDataDir lbi
97 98

-- Cargo-culted from hgettext
99 100 101 102 103 104 105 106 107

#else

import Distribution.Simple

main :: IO ()
main = defaultMain

#endif