diff options
Diffstat (limited to 'src/Text/Pandoc/Translations.hs')
-rw-r--r-- | src/Text/Pandoc/Translations.hs | 59 |
1 files changed, 37 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs index 2185366fd..e2091f0a8 100644 --- a/src/Text/Pandoc/Translations.hs +++ b/src/Text/Pandoc/Translations.hs @@ -40,13 +40,19 @@ just the language part. File format is: -} module Text.Pandoc.Translations ( Term(..) - , Translations(..) + , Translations + , lookupTerm , readTranslations ) where +import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import GHC.Generics (Generic) -import Text.Pandoc.Shared (trim, safeRead) +import qualified Text.Pandoc.UTF8 as UTF8 +import Data.Text as T +import Text.Pandoc.Shared (safeRead) +import Data.Yaml as Yaml +import Data.Aeson.Types (typeMismatch) data Term = Preface @@ -68,27 +74,36 @@ data Term = | SeeAlso | Cc | To - deriving (Show, Eq, Ord, Generic, Read) + deriving (Show, Eq, Ord, Generic, Enum, Read) newtype Translations = Translations (M.Map Term String) - deriving (Show, Eq, Ord, Generic, Monoid) + deriving (Show, Generic, Monoid) -readTranslations :: String -> Either String Translations -readTranslations = foldr parseLine (Right mempty) . lines +instance FromJSON Term where + parseJSON (String t) = case safeRead (T.unpack t) of + Just t' -> pure t' + Nothing -> fail $ "Invalid Term name " ++ + show t + parseJSON invalid = typeMismatch "Term" invalid + +instance FromJSON Translations where + parseJSON (Object hm) = do + xs <- mapM addItem (HM.toList hm) + return $ Translations (M.fromList xs) + where addItem (k,v) = + case safeRead (T.unpack k) of + Nothing -> fail $ "Invalid Term name " ++ show k + Just t -> + case v of + (String s) -> return (t, T.unpack $ T.strip s) + inv -> typeMismatch "String" inv + parseJSON invalid = typeMismatch "Translations" invalid -parseLine :: String - -> Either String Translations - -> Either String Translations -parseLine _ (Left s) = Left s -parseLine ('#':_) x = x -parseLine [] x = x -parseLine t (Right (Translations tm)) = - if null rest - then Left $ "no colon in " ++ term - else - case safeRead term of - Nothing -> Left $ term ++ " is not a recognized term name" - Just term' -> Right (Translations $ (M.insert term' defn) tm) - where (trm, rest) = break (\c -> c == ':') t - defn = trim $ drop 1 rest - term = trim trm +lookupTerm :: Term -> Translations -> Maybe String +lookupTerm t (Translations tm) = M.lookup t tm + +readTranslations :: String -> Either String Translations +readTranslations s = + case Yaml.decodeEither' $ UTF8.fromString s of + Left err' -> Left $ prettyPrintParseException err' + Right t -> Right t |