{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Translations
   Copyright   : Copyright (C) 2017-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Data types for localization.

Translations are stored in @data/translations/langname.trans@,
where langname can be the full BCP47 language specifier, or
just the language part.  File format is:

> # A comment, ignored
> Figure: Figura
> Index: Indeksi

-}
module Text.Pandoc.Translations (
                           Term(..)
                         , Translations
                         , lookupTerm
                         , readTranslations
                         )
where
import Data.Aeson.Types (Value(..), FromJSON(..))
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.YAML as YAML
import GHC.Generics (Generic)
import Text.Pandoc.Shared (safeRead)
import qualified Text.Pandoc.UTF8 as UTF8

data Term =
    Abstract
  | Appendix
  | Bibliography
  | Cc
  | Chapter
  | Contents
  | Encl
  | Figure
  | Glossary
  | Index
  | Listing
  | ListOfFigures
  | ListOfTables
  | Page
  | Part
  | Preface
  | Proof
  | References
  | See
  | SeeAlso
  | Table
  | To
  deriving (Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Eq Term
Eq Term
-> (Term -> Term -> Ordering)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Term)
-> (Term -> Term -> Term)
-> Ord Term
Term -> Term -> Bool
Term -> Term -> Ordering
Term -> Term -> Term
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Term -> Term -> Term
$cmin :: Term -> Term -> Term
max :: Term -> Term -> Term
$cmax :: Term -> Term -> Term
>= :: Term -> Term -> Bool
$c>= :: Term -> Term -> Bool
> :: Term -> Term -> Bool
$c> :: Term -> Term -> Bool
<= :: Term -> Term -> Bool
$c<= :: Term -> Term -> Bool
< :: Term -> Term -> Bool
$c< :: Term -> Term -> Bool
compare :: Term -> Term -> Ordering
$ccompare :: Term -> Term -> Ordering
$cp1Ord :: Eq Term
Ord, (forall x. Term -> Rep Term x)
-> (forall x. Rep Term x -> Term) -> Generic Term
forall x. Rep Term x -> Term
forall x. Term -> Rep Term x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Term x -> Term
$cfrom :: forall x. Term -> Rep Term x
Generic, Int -> Term
Term -> Int
Term -> [Term]
Term -> Term
Term -> Term -> [Term]
Term -> Term -> Term -> [Term]
(Term -> Term)
-> (Term -> Term)
-> (Int -> Term)
-> (Term -> Int)
-> (Term -> [Term])
-> (Term -> Term -> [Term])
-> (Term -> Term -> [Term])
-> (Term -> Term -> Term -> [Term])
-> Enum Term
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Term -> Term -> Term -> [Term]
$cenumFromThenTo :: Term -> Term -> Term -> [Term]
enumFromTo :: Term -> Term -> [Term]
$cenumFromTo :: Term -> Term -> [Term]
enumFromThen :: Term -> Term -> [Term]
$cenumFromThen :: Term -> Term -> [Term]
enumFrom :: Term -> [Term]
$cenumFrom :: Term -> [Term]
fromEnum :: Term -> Int
$cfromEnum :: Term -> Int
toEnum :: Int -> Term
$ctoEnum :: Int -> Term
pred :: Term -> Term
$cpred :: Term -> Term
succ :: Term -> Term
$csucc :: Term -> Term
Enum, ReadPrec [Term]
ReadPrec Term
Int -> ReadS Term
ReadS [Term]
(Int -> ReadS Term)
-> ReadS [Term] -> ReadPrec Term -> ReadPrec [Term] -> Read Term
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Term]
$creadListPrec :: ReadPrec [Term]
readPrec :: ReadPrec Term
$creadPrec :: ReadPrec Term
readList :: ReadS [Term]
$creadList :: ReadS [Term]
readsPrec :: Int -> ReadS Term
$creadsPrec :: Int -> ReadS Term
Read)

newtype Translations = Translations (M.Map Term T.Text)
        deriving (Int -> Translations -> ShowS
[Translations] -> ShowS
Translations -> String
(Int -> Translations -> ShowS)
-> (Translations -> String)
-> ([Translations] -> ShowS)
-> Show Translations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Translations] -> ShowS
$cshowList :: [Translations] -> ShowS
show :: Translations -> String
$cshow :: Translations -> String
showsPrec :: Int -> Translations -> ShowS
$cshowsPrec :: Int -> Translations -> ShowS
Show, (forall x. Translations -> Rep Translations x)
-> (forall x. Rep Translations x -> Translations)
-> Generic Translations
forall x. Rep Translations x -> Translations
forall x. Translations -> Rep Translations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Translations x -> Translations
$cfrom :: forall x. Translations -> Rep Translations x
Generic, b -> Translations -> Translations
NonEmpty Translations -> Translations
Translations -> Translations -> Translations
(Translations -> Translations -> Translations)
-> (NonEmpty Translations -> Translations)
-> (forall b. Integral b => b -> Translations -> Translations)
-> Semigroup Translations
forall b. Integral b => b -> Translations -> Translations
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Translations -> Translations
$cstimes :: forall b. Integral b => b -> Translations -> Translations
sconcat :: NonEmpty Translations -> Translations
$csconcat :: NonEmpty Translations -> Translations
<> :: Translations -> Translations -> Translations
$c<> :: Translations -> Translations -> Translations
Semigroup, Semigroup Translations
Translations
Semigroup Translations
-> Translations
-> (Translations -> Translations -> Translations)
-> ([Translations] -> Translations)
-> Monoid Translations
[Translations] -> Translations
Translations -> Translations -> Translations
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Translations] -> Translations
$cmconcat :: [Translations] -> Translations
mappend :: Translations -> Translations -> Translations
$cmappend :: Translations -> Translations -> Translations
mempty :: Translations
$cmempty :: Translations
$cp1Monoid :: Semigroup Translations
Monoid)

instance FromJSON Term where
  parseJSON :: Value -> Parser Term
parseJSON (String Text
t) = case Text -> Maybe Term
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
t of
                               Just Term
t' -> Term -> Parser Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t'
                               Maybe Term
Nothing -> String -> Parser Term
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Term) -> String -> Parser Term
forall a b. (a -> b) -> a -> b
$ String
"Invalid Term name " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                                 Text -> String
forall a. Show a => a -> String
show Text
t
  parseJSON Value
invalid = String -> Value -> Parser Term
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Term" Value
invalid

instance YAML.FromYAML Term where
  parseYAML :: Node Pos -> Parser Term
parseYAML (YAML.Scalar Pos
_ (YAML.SStr Text
t)) =
                         case Text -> Maybe Term
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
t of
                               Just Term
t' -> Term -> Parser Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
t'
                               Maybe Term
Nothing -> String -> Parser Term
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser Term) -> String -> Parser Term
forall a b. (a -> b) -> a -> b
$ String
"Invalid Term name " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                                 Text -> String
forall a. Show a => a -> String
show Text
t
  parseYAML Node Pos
invalid = String -> Node Pos -> Parser Term
forall a. String -> Node Pos -> Parser a
YAML.typeMismatch String
"Term" Node Pos
invalid

instance FromJSON Translations where
  parseJSON :: Value -> Parser Translations
parseJSON (Object Object
hm) = do
    [(Term, Text)]
xs <- ((Text, Value) -> Parser (Term, Text))
-> [(Text, Value)] -> Parser [(Term, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Value) -> Parser (Term, Text)
forall a. Read a => (Text, Value) -> Parser (a, Text)
addItem (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
hm)
    Translations -> Parser Translations
forall (m :: * -> *) a. Monad m => a -> m a
return (Translations -> Parser Translations)
-> Translations -> Parser Translations
forall a b. (a -> b) -> a -> b
$ Map Term Text -> Translations
Translations ([(Term, Text)] -> Map Term Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Term, Text)]
xs)
    where addItem :: (Text, Value) -> Parser (a, Text)
addItem (Text
k,Value
v) =
            case Text -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
k of
                 Maybe a
Nothing -> String -> Parser (a, Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail (String -> Parser (a, Text)) -> String -> Parser (a, Text)
forall a b. (a -> b) -> a -> b
$ String
"Invalid Term name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k
                 Just a
t  ->
                   case Value
v of
                        (String Text
s) -> (a, Text) -> Parser (a, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
t, Text -> Text
T.strip Text
s)
                        Value
inv        -> String -> Value -> Parser (a, Text)
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"String" Value
inv
  parseJSON Value
invalid = String -> Value -> Parser Translations
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Translations" Value
invalid

instance YAML.FromYAML Translations where
  parseYAML :: Node Pos -> Parser Translations
parseYAML = String
-> (Mapping Pos -> Parser Translations)
-> Node Pos
-> Parser Translations
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
YAML.withMap String
"Translations" ((Mapping Pos -> Parser Translations)
 -> Node Pos -> Parser Translations)
-> (Mapping Pos -> Parser Translations)
-> Node Pos
-> Parser Translations
forall a b. (a -> b) -> a -> b
$
    \Mapping Pos
tr -> Map Term Text -> Translations
Translations (Map Term Text -> Translations)
-> ([(Term, Text)] -> Map Term Text)
-> [(Term, Text)]
-> Translations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(Term, Text)] -> Map Term Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Term, Text)] -> Translations)
-> Parser [(Term, Text)] -> Parser Translations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node Pos, Node Pos) -> Parser (Term, Text))
-> [(Node Pos, Node Pos)] -> Parser [(Term, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Node Pos, Node Pos) -> Parser (Term, Text)
forall a. Read a => (Node Pos, Node Pos) -> Parser (a, Text)
addItem (Mapping Pos -> [(Node Pos, Node Pos)]
forall k a. Map k a -> [(k, a)]
M.toList Mapping Pos
tr)
   where addItem :: (Node Pos, Node Pos) -> Parser (a, Text)
addItem (n :: Node Pos
n@(YAML.Scalar Pos
_ (YAML.SStr Text
k)), Node Pos
v) =
            case Text -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
k of
                 Maybe a
Nothing -> String -> Node Pos -> Parser (a, Text)
forall a. String -> Node Pos -> Parser a
YAML.typeMismatch String
"Term" Node Pos
n
                 Just a
t  ->
                   case Node Pos
v of
                        (YAML.Scalar Pos
_ (YAML.SStr Text
s)) ->
                          (a, Text) -> Parser (a, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
t, Text -> Text
T.strip Text
s)
                        Node Pos
n' -> String -> Node Pos -> Parser (a, Text)
forall a. String -> Node Pos -> Parser a
YAML.typeMismatch String
"String" Node Pos
n'
         addItem (Node Pos
n, Node Pos
_) = String -> Node Pos -> Parser (a, Text)
forall a. String -> Node Pos -> Parser a
YAML.typeMismatch String
"String" Node Pos
n

lookupTerm :: Term -> Translations -> Maybe T.Text
lookupTerm :: Term -> Translations -> Maybe Text
lookupTerm Term
t (Translations Map Term Text
tm) = Term -> Map Term Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Term
t Map Term Text
tm

readTranslations :: T.Text -> Either T.Text Translations
readTranslations :: Text -> Either Text Translations
readTranslations Text
s =
  case ByteString -> Either (Pos, String) [Translations]
forall v. FromYAML v => ByteString -> Either (Pos, String) [v]
YAML.decodeStrict (ByteString -> Either (Pos, String) [Translations])
-> ByteString -> Either (Pos, String) [Translations]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
s of
       Left (Pos
pos,String
err') -> Text -> Either Text Translations
forall a b. a -> Either a b
Left (Text -> Either Text Translations)
-> Text -> Either Text Translations
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
err' String -> ShowS
forall a. [a] -> [a] -> [a]
++
           String
" (line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Pos -> Int
YAML.posLine Pos
pos) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" column " String -> ShowS
forall a. [a] -> [a] -> [a]
++
           Int -> String
forall a. Show a => a -> String
show (Pos -> Int
YAML.posColumn Pos
pos) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
       Right (Translations
t:[Translations]
_)     -> Translations -> Either Text Translations
forall a b. b -> Either a b
Right Translations
t
       Right []        -> Text -> Either Text Translations
forall a b. a -> Either a b
Left Text
"empty YAML document"