{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.CSL.Data
( getLocale
, CSLLocaleException(..)
, getDefaultCSL
, getManPage
, getLicense
, langBase
) where
import Prelude
import qualified Control.Exception as E
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Data.Text (Text)
import Data.Typeable
import System.FilePath ()
import Data.Maybe (fromMaybe)
#ifdef EMBED_DATA_FILES
import Text.CSL.Data.Embedded (defaultCSL, license, localeFiles,
manpage)
#else
import Paths_pandoc_citeproc (getDataFileName)
import System.Directory (doesFileExist)
#endif
data CSLLocaleException =
CSLLocaleNotFound Text
| CSLLocaleReadError E.IOException
deriving Typeable
instance Show CSLLocaleException where
show :: CSLLocaleException -> String
show (CSLLocaleNotFound s :: Text
s) = "Could not find locale data for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s
show (CSLLocaleReadError e :: IOException
e) = IOException -> String
forall a. Show a => a -> String
show IOException
e
instance E.Exception CSLLocaleException
getLocale :: Text -> IO L.ByteString
getLocale :: Text -> IO ByteString
getLocale s :: Text
s = do
let baseLocale :: Text
baseLocale = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='.') Text
s
#ifdef EMBED_DATA_FILES
let toLazy x = L.fromChunks [x]
let returnDefaultLocale =
maybe (E.throwIO $ CSLLocaleNotFound "en-US") (return . toLazy)
$ lookup "locales-en-US.xml" localeFiles
case T.length baseLocale of
0 -> returnDefaultLocale
1 | baseLocale == "C" -> returnDefaultLocale
_ -> let localeFile = T.unpack ("locales-" <>
baseLocale <> ".xml")
in case lookup localeFile localeFiles of
Just x' -> return $ toLazy x'
Nothing ->
let shortLocale = T.takeWhile (/='-') baseLocale
lang = fromMaybe shortLocale $
lookup shortLocale langBase
slFile = T.unpack $ T.concat ["locales-",lang,".xml"]
in
case lookup slFile localeFiles of
Just x'' -> return $ toLazy x''
_ -> E.throwIO $ CSLLocaleNotFound s
#else
String
f <- String -> IO String
getDataFileName (String -> IO String) -> (Text -> String) -> Text -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> IO String) -> Text -> IO String
forall a b. (a -> b) -> a -> b
$
case Text -> Int
T.length Text
baseLocale of
0 -> "locales/locales-en-US.xml"
1 | Text
baseLocale Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "C" -> "locales/locales-en-US.xml"
2 -> "locales/locales-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
s (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s [(Text, Text)]
langBase) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".xml"
_ -> "locales/locales-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take 5 Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".xml"
Bool
exists <- String -> IO Bool
doesFileExist String
f
if Bool -> Bool
not Bool
exists Bool -> Bool -> Bool
&& Text -> Int -> Ordering
T.compareLength Text
baseLocale 2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
then do
let (langOnly :: Text
langOnly, rest :: Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='-') Text
baseLocale
if Text -> Bool
T.null Text
rest Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
langOnly
then CSLLocaleException -> IO ByteString
forall e a. Exception e => e -> IO a
E.throwIO (CSLLocaleException -> IO ByteString)
-> CSLLocaleException -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> CSLLocaleException
CSLLocaleNotFound Text
baseLocale
else Text -> IO ByteString
getLocale Text
langOnly
else (IOException -> IO ByteString) -> IO ByteString -> IO ByteString
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (CSLLocaleException -> IO ByteString
forall e a. Exception e => e -> IO a
E.throwIO (CSLLocaleException -> IO ByteString)
-> (IOException -> CSLLocaleException)
-> IOException
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> CSLLocaleException
CSLLocaleReadError) (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
L.readFile String
f
#endif
getDefaultCSL :: IO L.ByteString
getDefaultCSL :: IO ByteString
getDefaultCSL =
#ifdef EMBED_DATA_FILES
return $ L.fromChunks [defaultCSL]
#else
String -> IO String
getDataFileName "chicago-author-date.csl" IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
L.readFile
#endif
getManPage :: IO L.ByteString
getManPage :: IO ByteString
getManPage =
#ifdef EMBED_DATA_FILES
return $ L.fromChunks [manpage]
#else
String -> IO String
getDataFileName "man/man1/pandoc-citeproc.1" IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
L.readFile
#endif
getLicense :: IO L.ByteString
getLicense :: IO ByteString
getLicense =
#ifdef EMBED_DATA_FILES
return $ L.fromChunks [license]
#else
String -> IO String
getDataFileName "LICENSE" IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
L.readFile
#endif
langBase :: [(Text, Text)]
langBase :: [(Text, Text)]
langBase
= [("af", "af-ZA")
,("bg", "bg-BG")
,("ca", "ca-AD")
,("cs", "cs-CZ")
,("da", "da-DK")
,("de", "de-DE")
,("el", "el-GR")
,("en", "en-US")
,("es", "es-ES")
,("et", "et-EE")
,("fa", "fa-IR")
,("fi", "fi-FI")
,("fr", "fr-FR")
,("he", "he-IL")
,("hr", "hr-HR")
,("hu", "hu-HU")
,("is", "is-IS")
,("it", "it-IT")
,("ja", "ja-JP")
,("km", "km-KH")
,("ko", "ko-KR")
,("lt", "lt-LT")
,("lv", "lv-LV")
,("mn", "mn-MN")
,("nb", "nb-NO")
,("nl", "nl-NL")
,("nn", "nn-NO")
,("pl", "pl-PL")
,("pt", "pt-PT")
,("ro", "ro-RO")
,("ru", "ru-RU")
,("sk", "sk-SK")
,("sl", "sl-SI")
,("sr", "sr-RS")
,("sv", "sv-SE")
,("th", "th-TH")
,("tr", "tr-TR")
,("uk", "uk-UA")
,("vi", "vi-VN")
,("zh", "zh-CN")
]