{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Citeproc.Locale
( parseLocale,
getLocale,
getPrimaryDialect
)
where
import Citeproc.Types
import Citeproc.Element (runElementParser, pLocale)
import Citeproc.Data (localeFiles)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Text.XML as X
import System.FilePath (takeExtension, dropExtension)
import qualified Data.Text as T
import Data.Default (def)
import qualified Data.Text.Lazy as TL
import Data.Text.Encoding (decodeUtf8)
import Control.Applicative ((<|>))
parseLocale :: Text -> Either CiteprocError Locale
parseLocale :: Text -> Either CiteprocError Locale
parseLocale Text
t =
case ParseSettings -> Text -> Either SomeException Document
X.parseText ParseSettings
forall a. Default a => a
def (Text -> Either SomeException Document)
-> Text -> Either SomeException Document
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
t of
Left SomeException
e -> CiteprocError -> Either CiteprocError Locale
forall a b. a -> Either a b
Left (CiteprocError -> Either CiteprocError Locale)
-> CiteprocError -> Either CiteprocError Locale
forall a b. (a -> b) -> a -> b
$ Text -> CiteprocError
CiteprocXMLError (String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
Right Document
n -> ElementParser Locale -> Either CiteprocError Locale
forall a. ElementParser a -> Either CiteprocError a
runElementParser (ElementParser Locale -> Either CiteprocError Locale)
-> ElementParser Locale -> Either CiteprocError Locale
forall a b. (a -> b) -> a -> b
$ Element -> ElementParser Locale
pLocale (Element -> ElementParser Locale)
-> Element -> ElementParser Locale
forall a b. (a -> b) -> a -> b
$ Document -> Element
X.documentRoot Document
n
primaryDialectMap :: M.Map Text Text
primaryDialectMap :: Map Text Text
primaryDialectMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Text
"af", Text
"af-ZA"),
(Text
"ar", Text
"ar"),
(Text
"bg", Text
"bg-BG"),
(Text
"ca", Text
"ca-AD"),
(Text
"cs", Text
"cs-CZ"),
(Text
"cy", Text
"cy-GB"),
(Text
"da", Text
"da-DK"),
(Text
"de", Text
"de-DE"),
(Text
"el", Text
"el-GR"),
(Text
"en", Text
"en-US"),
(Text
"es", Text
"es-ES"),
(Text
"et", Text
"et-EE"),
(Text
"eu", Text
"eu"),
(Text
"fa", Text
"fa-IR"),
(Text
"fi", Text
"fi-FI"),
(Text
"fr", Text
"fr-FR"),
(Text
"he", Text
"he-IL"),
(Text
"hr", Text
"hr-HR"),
(Text
"hu", Text
"hu-HU"),
(Text
"id", Text
"id-ID"),
(Text
"is", Text
"is-IS"),
(Text
"it", Text
"it-IT"),
(Text
"ja", Text
"ja-JP"),
(Text
"km", Text
"km-KH"),
(Text
"ko", Text
"ko-KR"),
(Text
"la", Text
"la"),
(Text
"lt", Text
"lt-LT"),
(Text
"lv", Text
"lv-LV"),
(Text
"mn", Text
"mn-MN"),
(Text
"nb", Text
"nb-NO"),
(Text
"nl", Text
"nl-NL"),
(Text
"nn", Text
"nn-NO"),
(Text
"pl", Text
"pl-PL"),
(Text
"pt", Text
"pt-PT"),
(Text
"ro", Text
"ro-RO"),
(Text
"ru", Text
"ru-RU"),
(Text
"sk", Text
"sk-SK"),
(Text
"sl", Text
"sl-SI"),
(Text
"sr", Text
"sr-RS"),
(Text
"sv", Text
"sv-SE"),
(Text
"th", Text
"th-TH"),
(Text
"tr", Text
"tr-TR"),
(Text
"uk", Text
"uk-UA"),
(Text
"vi", Text
"vi-VN"),
(Text
"zh", Text
"zh-CN")
]
getPrimaryDialect :: Lang -> Maybe Lang
getPrimaryDialect :: Lang -> Maybe Lang
getPrimaryDialect Lang
l =
Text -> Lang
parseLang (Text -> Lang) -> Maybe Text -> Maybe Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Lang -> Text
langLanguage Lang
l) Map Text Text
primaryDialectMap
locales :: M.Map Lang (Either CiteprocError Locale)
locales :: Map Lang (Either CiteprocError Locale)
locales = ((String, ByteString)
-> Map Lang (Either CiteprocError Locale)
-> Map Lang (Either CiteprocError Locale))
-> Map Lang (Either CiteprocError Locale)
-> [(String, ByteString)]
-> Map Lang (Either CiteprocError Locale)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String, ByteString)
-> Map Lang (Either CiteprocError Locale)
-> Map Lang (Either CiteprocError Locale)
go Map Lang (Either CiteprocError Locale)
forall a. Monoid a => a
mempty [(String, ByteString)]
localeFiles
where
go :: (String, ByteString)
-> Map Lang (Either CiteprocError Locale)
-> Map Lang (Either CiteprocError Locale)
go (String
fp, ByteString
bs) Map Lang (Either CiteprocError Locale)
m
| String -> String
takeExtension String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".xml"
= let lang :: Lang
lang = Text -> Lang
parseLang (Text -> Lang) -> Text -> Lang
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
fp
in Lang
-> Either CiteprocError Locale
-> Map Lang (Either CiteprocError Locale)
-> Map Lang (Either CiteprocError Locale)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Lang
lang (Text -> Either CiteprocError Locale
parseLocale (Text -> Either CiteprocError Locale)
-> Text -> Either CiteprocError Locale
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
bs) Map Lang (Either CiteprocError Locale)
m
| Bool
otherwise = Map Lang (Either CiteprocError Locale)
m
getLocale :: Lang -> Either CiteprocError Locale
getLocale :: Lang -> Either CiteprocError Locale
getLocale Lang
lang =
case Lang
-> Map Lang (Either CiteprocError Locale)
-> Maybe (Either CiteprocError Locale)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Lang
lang Map Lang (Either CiteprocError Locale)
locales
Maybe (Either CiteprocError Locale)
-> Maybe (Either CiteprocError Locale)
-> Maybe (Either CiteprocError Locale)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Lang -> Maybe Lang
getPrimaryDialect Lang
lang Maybe Lang
-> (Lang -> Maybe (Either CiteprocError Locale))
-> Maybe (Either CiteprocError Locale)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Lang
lang' -> Lang
-> Map Lang (Either CiteprocError Locale)
-> Maybe (Either CiteprocError Locale)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Lang
lang' Map Lang (Either CiteprocError Locale)
locales) of
Just Either CiteprocError Locale
loc -> Either CiteprocError Locale
loc
Maybe (Either CiteprocError Locale)
Nothing -> CiteprocError -> Either CiteprocError Locale
forall a b. a -> Either a b
Left (CiteprocError -> Either CiteprocError Locale)
-> CiteprocError -> Either CiteprocError Locale
forall a b. (a -> b) -> a -> b
$ Text -> CiteprocError
CiteprocLocaleNotFound (Text -> CiteprocError) -> Text -> CiteprocError
forall a b. (a -> b) -> a -> b
$ Lang -> Text
renderLang Lang
lang