{-# 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 Text
s) = String
"Could not find locale data for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s
show (CSLLocaleReadError 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 Text
s = do
let baseLocale :: Text
baseLocale = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') 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
Int
0 -> Text
"locales/locales-en-US.xml"
Int
1 | Text
baseLocale Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"C" -> Text
"locales/locales-en-US.xml"
Int
2 -> Text
"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
<> Text
".xml"
Int
_ -> Text
"locales/locales-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
5 Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".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 Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
then Text -> IO ByteString
getLocale (Text -> IO ByteString) -> Text -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'-') Text
baseLocale
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 String
"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 String
"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 String
"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
= [(Text
"af", Text
"af-ZA")
,(Text
"bg", Text
"bg-BG")
,(Text
"ca", Text
"ca-AD")
,(Text
"cs", Text
"cs-CZ")
,(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
"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
"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
"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")
]