    {-# 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 t :: Text
    t) = case Text -> Maybe Term
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Text
    t of
                                   Just t' :: Term
    t' -> Term -> Parser Term
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Term
    t'
                                   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
    $ "Invalid Term name " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                                     Text -> String
    forall a. Show a => a -> String
    show Text
    t
      parseJSON invalid :: Value
    invalid = String -> Value -> Parser Term
    forall a. String -> Value -> Parser a
    Aeson.typeMismatch "Term" Value
    invalid

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

    instance FromJSON Translations where
      parseJSON :: Value -> Parser Translations
    parseJSON (Object hm :: 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 (k :: Text
    k,v :: Value
    v) =
                case Text -> Maybe a
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Text
    k of
                     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
    $ "Invalid Term name " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    k
                     Just t :: a
    t  ->
                       case Value
    v of
                            (String s :: Text
    s) -> (a, Text) -> Parser (a, Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    t, Text -> Text
    T.strip Text
    s)
                            inv :: Value
    inv        -> String -> Value -> Parser (a, Text)
    forall a. String -> Value -> Parser a
    Aeson.typeMismatch "String" Value
    inv
      parseJSON invalid :: Value
    invalid = String -> Value -> Parser Translations
    forall a. String -> Value -> Parser a
    Aeson.typeMismatch "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 "Translations" ((Mapping Pos -> Parser Translations)
     -> Node Pos -> Parser Translations)
    -> (Mapping Pos -> Parser Translations)
    -> Node Pos
    -> Parser Translations
    forall a b. (a -> b) -> a -> b
    $
        \tr :: 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 _ (YAML.SStr k :: Text
    k)), v :: Node Pos
    v) =
                case Text -> Maybe a
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
    safeRead Text
    k of
                     Nothing -> String -> Node Pos -> Parser (a, Text)
    forall a. String -> Node Pos -> Parser a
    YAML.typeMismatch "Term" Node Pos
    n
                     Just t :: a
    t  ->
                       case Node Pos
    v of
                            (YAML.Scalar _ (YAML.SStr s :: Text
    s)) ->
                              (a, Text) -> Parser (a, Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    t, Text -> Text
    T.strip Text
    s)
                            n' :: Node Pos
    n' -> String -> Node Pos -> Parser (a, Text)
    forall a. String -> Node Pos -> Parser a
    YAML.typeMismatch "String" Node Pos
    n'
             addItem (n :: Node Pos
    n, _) = String -> Node Pos -> Parser (a, Text)
    forall a. String -> Node Pos -> Parser a
    YAML.typeMismatch "String" Node Pos
    n

    lookupTerm :: Term -> Translations -> Maybe T.Text
    lookupTerm :: Term -> Translations -> Maybe Text
    lookupTerm t :: Term
    t (Translations tm :: 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 s :: 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
    pos,err' :: 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]
    ++
               " (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]
    ++ " 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]
    ++ ")"
           Right (t :: Translations
    t:_)     -> 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 "empty YAML document"