{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc.Util
 ( splitStrWhen
 , toIETF )
where
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Definition

-- Split Str elements so that characters satisfying the
-- predicate each have their own Str.
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen Char -> Bool
p = (Inline -> [Inline] -> [Inline])
-> [Inline] -> [Inline] -> [Inline]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Inline -> [Inline] -> [Inline]
go []
 where
  go :: Inline -> [Inline] -> [Inline]
go (Str Text
t) = ((Text -> Inline) -> [Text] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inline
Str ((Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
goesTogether Text
t) [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++)
  go Inline
x = (Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
  goesTogether :: Char -> Char -> Bool
goesTogether Char
c Char
d   = Bool -> Bool
not (Char -> Bool
p Char
c Bool -> Bool -> Bool
|| Char -> Bool
p Char
d)

toIETF :: Text -> Text
toIETF :: Text -> Text
toIETF Text
"english"         = Text
"en-US" -- "en-EN" unavailable in CSL
toIETF Text
"usenglish"       = Text
"en-US"
toIETF Text
"american"        = Text
"en-US"
toIETF Text
"british"         = Text
"en-GB"
toIETF Text
"ukenglish"       = Text
"en-GB"
toIETF Text
"canadian"        = Text
"en-US" -- "en-CA" unavailable in CSL
toIETF Text
"australian"      = Text
"en-GB" -- "en-AU" unavailable in CSL
toIETF Text
"newzealand"      = Text
"en-GB" -- "en-NZ" unavailable in CSL
toIETF Text
"afrikaans"       = Text
"af-ZA"
toIETF Text
"arabic"          = Text
"ar"
toIETF Text
"basque"          = Text
"eu"
toIETF Text
"bulgarian"       = Text
"bg-BG"
toIETF Text
"catalan"         = Text
"ca-AD"
toIETF Text
"croatian"        = Text
"hr-HR"
toIETF Text
"czech"           = Text
"cs-CZ"
toIETF Text
"danish"          = Text
"da-DK"
toIETF Text
"dutch"           = Text
"nl-NL"
toIETF Text
"estonian"        = Text
"et-EE"
toIETF Text
"finnish"         = Text
"fi-FI"
toIETF Text
"canadien"        = Text
"fr-CA"
toIETF Text
"acadian"         = Text
"fr-CA"
toIETF Text
"french"          = Text
"fr-FR"
toIETF Text
"francais"        = Text
"fr-FR"
toIETF Text
"austrian"        = Text
"de-AT"
toIETF Text
"naustrian"       = Text
"de-AT"
toIETF Text
"german"          = Text
"de-DE"
toIETF Text
"germanb"         = Text
"de-DE"
toIETF Text
"ngerman"         = Text
"de-DE"
toIETF Text
"greek"           = Text
"el-GR"
toIETF Text
"polutonikogreek" = Text
"el-GR"
toIETF Text
"hebrew"          = Text
"he-IL"
toIETF Text
"hungarian"       = Text
"hu-HU"
toIETF Text
"icelandic"       = Text
"is-IS"
toIETF Text
"italian"         = Text
"it-IT"
toIETF Text
"japanese"        = Text
"ja-JP"
toIETF Text
"latvian"         = Text
"lv-LV"
toIETF Text
"lithuanian"      = Text
"lt-LT"
toIETF Text
"magyar"          = Text
"hu-HU"
toIETF Text
"mongolian"       = Text
"mn-MN"
toIETF Text
"norsk"           = Text
"nb-NO"
toIETF Text
"nynorsk"         = Text
"nn-NO"
toIETF Text
"farsi"           = Text
"fa-IR"
toIETF Text
"polish"          = Text
"pl-PL"
toIETF Text
"brazil"          = Text
"pt-BR"
toIETF Text
"brazilian"       = Text
"pt-BR"
toIETF Text
"portugues"       = Text
"pt-PT"
toIETF Text
"portuguese"      = Text
"pt-PT"
toIETF Text
"romanian"        = Text
"ro-RO"
toIETF Text
"russian"         = Text
"ru-RU"
toIETF Text
"serbian"         = Text
"sr-RS"
toIETF Text
"serbianc"        = Text
"sr-RS"
toIETF Text
"slovak"          = Text
"sk-SK"
toIETF Text
"slovene"         = Text
"sl-SL"
toIETF Text
"spanish"         = Text
"es-ES"
toIETF Text
"swedish"         = Text
"sv-SE"
toIETF Text
"thai"            = Text
"th-TH"
toIETF Text
"turkish"         = Text
"tr-TR"
toIETF Text
"ukrainian"       = Text
"uk-UA"
toIETF Text
"vietnamese"      = Text
"vi-VN"
toIETF Text
"latin"           = Text
"la"
toIETF Text
x                 = Text
x