[hakyll] Seamless i18n with po4a

[p***@gmail.com]

Hello everyone!

I'm working on making Hakyll and po4a (https://po4a.org/) work together.

Requirement:

* Use the same Hakyll DSL, maybe with some wrappers.
* Minimal changes to Hakyl itself.
* Automatic updates of PO files.
* Automatic rewriting of original rules
* Automatic addition of translated rules

Let's have "original" file `index.html` with some compiler.
We know it's original language (let it be English) and we know the default
site language (may be not the original language).

Without translations, we would have this site:


./index.html


With translation enabled I want to get this (depending on the default
language):

./index.html (default language)
./es/index.html (translated from the original language to ES)
./en/index.html (original language - EN)




Some highlights (full source code follows):

Automatic update of translations:

-- | Update or create PO (Portable Object) files.
-- 1. Clean build original (untranslated) site
-- 2. Find all files to translate (*.html)
-- 3. Invoke `po4a-updatepo` with the list of files and desired translations
updatePO :: IO ()
updatePO = do
logger <- Log.new Log.Message
Cmd.clean config logger
rc <- Cmd.build config logger origRules
unless (rc == ExitSuccess) $ exitWith rc
provider <- newProvider
ruleSet <- runRules origRules provider
let compilers = RulesInt.rulesCompilers ruleSet
routes = RulesInt.rulesRoutes ruleSet
outputs <- mapM (Routes.runRoutes routes provider . fst) compilers
let outfiles =
map (destinationDirectory config </>) $
filter (isSuffixOf ".html") $ mapMaybe fst outputs
langs = filter (/= originalLang) allLanguages
cmd = "po4a-updatepo"
args =
["-f", "xhtml", "-M", "utf8"] ++
buildOpts "-m" outfiles ++ buildOpts "-p" (map poFile langs)
Log.header logger "Updating translations..."
Log.message logger $ cmd ++ " " ++ unwords args
callProcess cmd args
Cmd.clean config logger
Log.flush logger


To automatically create translated sites I need to access routes and
compilers from the original rules, optionally amend them, and add new rules
with amended routes and compilers. E. g. prepend language dir to the routes
and add one more step to compilers.

It seems that with current Hakyll I can't do it: I can't neither reuse,
nor update `Compiler SomeItem`.

Full source code (Note that I patch Hakyll to export `SomeItem`):

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wall #-}

import Control.Monad (unless)
import Data.Dynamic
import Data.List (isSuffixOf)
import Data.Maybe (fromJust, mapMaybe)
import Data.Monoid (mappend)
import Data.Typeable (Typeable)
import Hakyll
import qualified Hakyll.Commands as Cmd
import Hakyll.Core.Compiler.Internal (Compiler(..))
import Hakyll.Core.Item (Item)
import Hakyll.Core.Item.SomeItem (SomeItem(..))
import qualified Hakyll.Core.Logger as Log
import qualified Hakyll.Core.Provider as Provider
import qualified Hakyll.Core.Routes as Routes
import Hakyll.Core.Rules.Internal (runRules)
import qualified Hakyll.Core.Rules.Internal as RulesInt
import qualified Hakyll.Core.Store as Store
import Hakyll.Core.Writable (Writable)
import System.Exit (ExitCode(ExitSuccess), exitWith)
import System.FilePath ((</>))
import System.Process (callProcess)

-- |
defaultLang :: String
defaultLang = "ru"

-- |
originalLang :: String
originalLang = "en"

allLanguages :: [String]
allLanguages = ["en", "ru", "zh"]

origRules :: Rules ()
origRules = do
match "images/*" $ do
route idRoute
compile copyFileCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match (fromList ["about.rst", "contact.markdown"]) $ do
route $ setExtension "html"
compile $
pandocCompiler >>=
loadAndApplyTemplate "templates/default.html" defaultContext >>=
relativizeUrls
match "posts/*" $ do
route $ setExtension "html"
compile $
pandocCompiler >>= loadAndApplyTemplate "templates/post.html" postCtx

=

loadAndApplyTemplate "templates/default.html" postCtx >>=
relativizeUrls
create ["archive.html"] $ do
route $ setExtension "html"
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let archiveCtx =
listField "posts" postCtx (return posts) `mappend`
constField "title" "Archives" `mappend`
defaultContext
makeItem "" >>= loadAndApplyTemplate "templates/archive.html"
archiveCtx >>=
loadAndApplyTemplate "templates/default.html" archiveCtx >>=
relativizeUrls
match "index.html" $ do
route $ setExtension "html"
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let indexCtx =
listField "posts" postCtx (return posts) `mappend`
constField "title" "Home" `mappend`
defaultContext
getResourceBody >>= applyAsTemplate indexCtx >>=
loadAndApplyTemplate "templates/default.html" indexCtx >>=
relativizeUrls
match "templates/*" $ compile templateBodyCompiler

langRoutes :: String -> Routes
langRoutes lang = customRoute (\i -> lang </> toFilePath i)

poFile :: String -> String
poFile lang = "po/" ++ lang ++ ".po"

langDependency :: String -> Dependency
langDependency = IdentifierDependency . fromFilePath . poFile

translateCompiler :: String -> String -> Compiler String
translateCompiler lang input = do
TmpFile orig <- newTmpFile "orig"
TmpFile tran <- newTmpFile lang
unsafeCompiler $ do
writeFile orig input
callProcess
"po4a-translate"
["-f", "xhtml", "-M", "utf8", "-p", poFile lang, "-m", orig, "-l",
tran]
readFile tran

translate :: String -> Item String -> Compiler (Item String)
translate lang orig = do
getUnderlying >>= debugCompiler . toFilePath
debugCompiler $ show orig
withItemBody (translateCompiler lang) orig

config :: Configuration
config = defaultConfiguration

newProvider :: IO Provider.Provider
newProvider = do
store <- Store.new (inMemoryCache config) (storeDirectory config)
Provider.newProvider
store
(shouldIgnoreFile config)
(providerDirectory config)

buildOpts :: String -> [String] -> [String]
buildOpts _ [] = []
buildOpts o (a:as) = o : a : buildOpts o as

-- | Update or create PO (Portable Object) files.
-- 1. Clean build original (untranslated) site
-- 2. Find all files to translate (*.html)
-- 3. Invoke `po4a-updatepo` with the list of files and desired translations
updatePO :: IO ()
updatePO = do
logger <- Log.new Log.Message
Cmd.clean config logger
rc <- Cmd.build config logger origRules
unless (rc == ExitSuccess) $ exitWith rc
provider <- newProvider
ruleSet <- runRules origRules provider
let compilers = RulesInt.rulesCompilers ruleSet
routes = RulesInt.rulesRoutes ruleSet
outputs <- mapM (Routes.runRoutes routes provider . fst) compilers
let outfiles =
map (destinationDirectory config </>) $
filter (isSuffixOf ".html") $ mapMaybe fst outputs
langs = filter (/= originalLang) allLanguages
cmd = "po4a-updatepo"
args =
["-f", "xhtml", "-M", "utf8"] ++
buildOpts "-m" outfiles ++ buildOpts "-p" (map poFile langs)
Log.header logger "Updating translations..."
Log.message logger $ cmd ++ " " ++ unwords args
callProcess cmd args
Cmd.clean config logger
Log.flush logger

newRules ::
Routes
-> Provider.Provider
-> (Identifier, Compiler SomeItem)
-> IO (Rules ())
newRules routes provider (identifier, compiler) = do
origRoute <- fst <$> Routes.runRoutes routes provider identifier
return $
case origRoute of
Nothing -> return ()
Just rt -> do
create [identifier] $ do
route $ constRoute rt
compile $ fmap unSomeItem compiler
where
unSomeItem :: (Typeable a) => SomeItem -> Item a
unSomeItem (SomeItem i) = fromJust $ fromDynamic (toDyn i)

translatedRules :: IO (Rules ())
translatedRules = do
provider <- newProvider
ruleSet <- runRules origRules provider
let compilers = RulesInt.rulesCompilers ruleSet
routes = RulesInt.rulesRoutes ruleSet
sequence_ <$> mapM (newRules routes provider) compilers

main :: IO ()
main = do
updatePO
rules <- translatedRules
logger <- Log.new Log.Message
exitWith =<< Cmd.build config logger rules

postCtx :: Context String
postCtx = dateField "date" "%B %e, %Y" `mappend` defaultContext

[Игорь Пашев]

Update PO:

Removing _site...
Removing _cache...
Removing _cache/tmp...
Initialising...
Creating store...
Creating provider...
Running rules...
Checking for out-of-date items
Compiling
updated templates/default.html
updated about.rst
updated templates/post.html
updated posts/2015-08-12-spqr.markdown
updated posts/2015-10-07-rosa-rosa-rosam.markdown
updated posts/2015-11-28-carpe-diem.markdown
updated posts/2015-12-07-tu-quoque.markdown
updated templates/archive.html
updated templates/post-list.html
updated archive.html
updated contact.markdown
updated css/default.css
updated images/haskell-logo.png
updated index.html
Success
Updating translations...
po4a-updatepo -f xhtml -M utf8 -m _site/about.html -m _site/
archive.html -m _site/contact.html -m _site/index.html -m _site/posts/2015-
08-12-spqr.html -m _site/posts/2015-10-07-rosa-rosa-rosam.html -m _site/
posts/2015-11-28-carpe-diem.html -m _site/posts/2015-12-07-tu-quoque.html -p
po/ru.po -p po/zh.po
........... done.
...... done.
Removing _site...
Removing _cache...
Removing _cache/tmp...