diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/ConTeXt.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 375 |
1 files changed, 230 insertions, 145 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index c663c75ce..f94c12d89 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {- -Copyright (C) 2007-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2007-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ConTeXt - Copyright : Copyright (C) 2007-2015 John MacFarlane + Copyright : Copyright (C) 2007-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -29,20 +30,24 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into ConTeXt. -} module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where +import Control.Monad.State.Strict +import Data.Char (ord, isDigit) +import Data.List (intercalate, intersperse) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Network.URI (unEscapeString) +import Text.Pandoc.BCP47 +import Text.Pandoc.Class (PandocMonad, report, toLang) import Text.Pandoc.Definition -import Text.Pandoc.Shared -import Text.Pandoc.Writers.Shared +import Text.Pandoc.ImageSize +import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Walk (query) -import Text.Printf ( printf ) -import Data.List ( intercalate, intersperse ) -import Data.Char ( ord ) -import Data.Maybe ( catMaybes ) -import Control.Monad.State import Text.Pandoc.Pretty -import Text.Pandoc.ImageSize -import Text.Pandoc.Templates ( renderTemplate' ) -import Network.URI ( isURI, unEscapeString ) +import Text.Pandoc.Shared +import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.Walk (query) +import Text.Pandoc.Writers.Shared +import Text.Printf (printf) data WriterState = WriterState { stNextRef :: Int -- number of next URL reference @@ -50,37 +55,43 @@ data WriterState = , stOptions :: WriterOptions -- writer options } +data Tabl = Xtb | Ntb deriving (Show, Eq) + orderedListStyles :: [Char] orderedListStyles = cycle "narg" -- | Convert Pandoc to ConTeXt. -writeConTeXt :: WriterOptions -> Pandoc -> String +writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeConTeXt options document = let defaultWriterState = WriterState { stNextRef = 1 , stOrderedListLevel = 0 , stOptions = options } - in evalState (pandocToConTeXt options document) defaultWriterState + in evalStateT (pandocToConTeXt options document) defaultWriterState -pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String +type WM = StateT WriterState + +pandocToConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> WM m Text pandocToConTeXt options (Pandoc meta blocks) = do let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing + let render' :: Doc -> Text + render' = render colwidth metadata <- metaToJSON options - (fmap (render colwidth) . blockListToConTeXt) - (fmap (render colwidth) . inlineListToConTeXt) + (fmap render' . blockListToConTeXt) + (fmap render' . inlineListToConTeXt) meta body <- mapM (elementToConTeXt options) $ hierarchicalize blocks - let main = (render colwidth . vcat) body - let layoutFromMargins = intercalate [','] $ catMaybes $ - map (\(x,y) -> + let main = (render' . vcat) body + let layoutFromMargins = intercalate [','] $ mapMaybe (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("leftmargin","margin-left") ,("rightmargin","margin-right") ,("top","margin-top") ,("bottom","margin-bottom") ] + mblang <- fromBCP47 (getLang options meta) let context = defField "toc" (writerTableOfContents options) $ defField "placelist" (intercalate ("," :: String) $ take (writerTOCDepth options + @@ -93,14 +104,17 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ defField "body" main $ defField "layout" layoutFromMargins $ defField "number-sections" (writerNumberSections options) - $ metadata - let context' = defField "context-lang" (maybe "" (fromBcp47 . splitBy (=='-')) $ - getField "lang" context) - $ defField "context-dir" (toContextDir $ getField "dir" context) - $ context - return $ case writerTemplate options of - Nothing -> main - Just tpl -> renderTemplate' tpl context' + $ maybe id (defField "context-lang") mblang + $ (case getField "papersize" metadata of + Just (('a':d:ds) :: String) + | all isDigit (d:ds) -> resetField "papersize" + (('A':d:ds) :: String) + _ -> id) metadata + let context' = defField "context-dir" (toContextDir + $ getField "dir" context) context + case writerTemplate options of + Nothing -> return main + Just tpl -> renderTemplate' tpl context' toContextDir :: Maybe String -> String toContextDir (Just "rtl") = "r2l" @@ -110,24 +124,24 @@ toContextDir _ = "" -- | escape things as needed for ConTeXt escapeCharForConTeXt :: WriterOptions -> Char -> String escapeCharForConTeXt opts ch = - let ligatures = writerTeXLigatures opts in + let ligatures = isEnabled Ext_smart opts in case ch of - '{' -> "\\{" - '}' -> "\\}" - '\\' -> "\\letterbackslash{}" - '$' -> "\\$" - '|' -> "\\letterbar{}" - '%' -> "\\letterpercent{}" - '~' -> "\\lettertilde{}" - '#' -> "\\#" - '[' -> "{[}" - ']' -> "{]}" - '\160' -> "~" + '{' -> "\\{" + '}' -> "\\}" + '\\' -> "\\letterbackslash{}" + '$' -> "\\$" + '|' -> "\\letterbar{}" + '%' -> "\\letterpercent{}" + '~' -> "\\lettertilde{}" + '#' -> "\\#" + '[' -> "{[}" + ']' -> "{]}" + '\160' -> "~" '\x2014' | ligatures -> "---" '\x2013' | ligatures -> "--" '\x2019' | ligatures -> "'" '\x2026' -> "\\ldots{}" - x -> [x] + x -> [x] -- | Escape string for ConTeXt stringToConTeXt :: WriterOptions -> String -> String @@ -137,20 +151,20 @@ stringToConTeXt opts = concatMap (escapeCharForConTeXt opts) toLabel :: String -> String toLabel z = concatMap go z where go x - | elem x ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) + | x `elem` ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) | otherwise = [x] -- | Convert Elements to ConTeXt -elementToConTeXt :: WriterOptions -> Element -> State WriterState Doc +elementToConTeXt :: PandocMonad m => WriterOptions -> Element -> WM m Doc elementToConTeXt _ (Blk block) = blockToConTeXt block elementToConTeXt opts (Sec level _ attr title' elements) = do header' <- sectionHeader attr level title' + footer' <- sectionFooter attr level innerContents <- mapM (elementToConTeXt opts) elements - return $ vcat (header' : innerContents) + return $ header' $$ vcat innerContents $$ footer' -- | Convert Pandoc block element to ConTeXt. -blockToConTeXt :: Block - -> State WriterState Doc +blockToConTeXt :: PandocMonad m => Block -> WM m Doc blockToConTeXt Null = return empty blockToConTeXt (Plain lst) = inlineListToConTeXt lst -- title beginning with fig: indicates that the image is a figure @@ -175,9 +189,12 @@ blockToConTeXt (CodeBlock _ str) = return $ flush ("\\starttyping" <> cr <> text str <> cr <> "\\stoptyping") $$ blankline -- blankline because \stoptyping can't have anything after it, inc. '}' blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline -blockToConTeXt (RawBlock _ _ ) = return empty +blockToConTeXt b@(RawBlock _ _ ) = do + report $ BlockNotRendered b + return empty blockToConTeXt (Div (ident,_,kvs) bs) = do let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" + mblang <- fromBCP47 (lookup "lang" kvs) let wrapRef txt = if null ident then txt else ("\\reference" <> brackets (text $ toLabel ident) <> @@ -186,12 +203,12 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do Just "rtl" -> align "righttoleft" Just "ltr" -> align "lefttoright" _ -> id - wrapLang txt = case lookup "lang" kvs of + wrapLang txt = case mblang of Just lng -> "\\start\\language[" - <> text (fromBcp47' lng) <> "]" $$ txt $$ "\\stop" + <> text lng <> "]" $$ txt $$ "\\stop" Nothing -> txt wrapBlank txt = blankline <> txt <> blankline - fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs + (wrapBlank . wrapLang . wrapDir . wrapRef) <$> blockListToConTeXt bs blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ ("\\startitemize" <> if isTightList lst @@ -201,9 +218,9 @@ blockToConTeXt (BulletList lst) = do blockToConTeXt (OrderedList (start, style', delim) lst) = do st <- get let level = stOrderedListLevel st - put $ st {stOrderedListLevel = level + 1} + put st {stOrderedListLevel = level + 1} contents <- mapM listItemToConTeXt lst - put $ st {stOrderedListLevel = level} + put st {stOrderedListLevel = level} let start' = if start == 1 then "" else "start=" ++ show start let delim' = case delim of DefaultDelim -> "" @@ -238,39 +255,83 @@ blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline -- If this is ever executed, provide a default for the reference identifier. blockToConTeXt (Header level attr lst) = sectionHeader attr level lst blockToConTeXt (Table caption aligns widths heads rows) = do - let colDescriptor colWidth alignment = (case alignment of - AlignLeft -> 'l' - AlignRight -> 'r' - AlignCenter -> 'c' - AlignDefault -> 'l'): - if colWidth == 0 - then "|" - else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|") - let colDescriptors = "|" ++ (concat $ - zipWith colDescriptor widths aligns) - headers <- if all null heads - then return empty - else liftM ($$ "\\HL") $ tableRowToConTeXt heads + opts <- gets stOptions + let tabl = if isEnabled Ext_ntb opts + then Ntb + else Xtb captionText <- inlineListToConTeXt caption - rows' <- mapM tableRowToConTeXt rows - return $ "\\placetable" <> (if null caption - then brackets "none" - else empty) - <> braces captionText $$ - "\\starttable" <> brackets (text colDescriptors) $$ - "\\HL" $$ headers $$ - vcat rows' $$ "\\HL" $$ "\\stoptable" <> blankline - -tableRowToConTeXt :: [[Block]] -> State WriterState Doc -tableRowToConTeXt cols = do - cols' <- mapM blockListToConTeXt cols - return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR" - -listItemToConTeXt :: [Block] -> State WriterState Doc + headers <- if all null heads + then return empty + else tableRowToConTeXt tabl aligns widths heads + rows' <- mapM (tableRowToConTeXt tabl aligns widths) rows + body <- tableToConTeXt tabl headers rows' + return $ "\\startplacetable" <> brackets ( + if null caption + then "location=none" + else "title=" <> braces captionText + ) $$ body $$ "\\stopplacetable" <> blankline + +tableToConTeXt :: PandocMonad m => Tabl -> Doc -> [Doc] -> WM m Doc +tableToConTeXt Xtb heads rows = + return $ "\\startxtable" $$ + (if isEmpty heads + then empty + else "\\startxtablehead[head]" $$ heads $$ "\\stopxtablehead") $$ + (if null rows + then empty + else "\\startxtablebody[body]" $$ vcat (init rows) $$ "\\stopxtablebody" $$ + "\\startxtablefoot[foot]" $$ last rows $$ "\\stopxtablefoot") $$ + "\\stopxtable" +tableToConTeXt Ntb heads rows = + return $ "\\startTABLE" $$ + (if isEmpty heads + then empty + else "\\startTABLEhead" $$ heads $$ "\\stopTABLEhead") $$ + (if null rows + then empty + else "\\startTABLEbody" $$ vcat (init rows) $$ "\\stopTABLEbody" $$ + "\\startTABLEfoot" $$ last rows $$ "\\stopTABLEfoot") $$ + "\\stopTABLE" + +tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m Doc +tableRowToConTeXt Xtb aligns widths cols = do + cells <- mapM (tableColToConTeXt Xtb) $ zip3 aligns widths cols + return $ "\\startxrow" $$ vcat cells $$ "\\stopxrow" +tableRowToConTeXt Ntb aligns widths cols = do + cells <- mapM (tableColToConTeXt Ntb) $ zip3 aligns widths cols + return $ vcat cells $$ "\\NC\\NR" + +tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m Doc +tableColToConTeXt tabl (align, width, blocks) = do + cellContents <- blockListToConTeXt blocks + let colwidth = if width == 0 + then empty + else "width=" <> braces (text (printf "%.2f\\textwidth" width)) + let halign = alignToConTeXt align + let options = (if keys == empty + then empty + else brackets keys) <> space + where keys = hcat $ intersperse "," $ filter (empty /=) [halign, colwidth] + tableCellToConTeXt tabl options cellContents + +tableCellToConTeXt :: PandocMonad m => Tabl -> Doc -> Doc -> WM m Doc +tableCellToConTeXt Xtb options cellContents = + return $ "\\startxcell" <> options <> cellContents <> " \\stopxcell" +tableCellToConTeXt Ntb options cellContents = + return $ "\\NC" <> options <> cellContents + +alignToConTeXt :: Alignment -> Doc +alignToConTeXt align = case align of + AlignLeft -> "align=right" + AlignRight -> "align=left" + AlignCenter -> "align=middle" + AlignDefault -> empty + +listItemToConTeXt :: PandocMonad m => [Block] -> WM m Doc listItemToConTeXt list = blockListToConTeXt list >>= - return . ("\\item" $$) . (nest 2) + return . ("\\item" $$) . nest 2 -defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState Doc +defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m Doc defListItemToConTeXt (term, defs) = do term' <- inlineListToConTeXt term def' <- liftM vsep $ mapM blockListToConTeXt defs @@ -278,12 +339,13 @@ defListItemToConTeXt (term, defs) = do "\\stopdescription" <> blankline -- | Convert list of block elements to ConTeXt. -blockListToConTeXt :: [Block] -> State WriterState Doc +blockListToConTeXt :: PandocMonad m => [Block] -> WM m Doc blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst -- | Convert list of inline elements to ConTeXt. -inlineListToConTeXt :: [Inline] -- ^ Inlines to convert - -> State WriterState Doc +inlineListToConTeXt :: PandocMonad m + => [Inline] -- ^ Inlines to convert + -> WM m Doc inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst -- We add a \strut after a line break that precedes a space, -- or the space gets swallowed @@ -292,13 +354,14 @@ inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst addStruts xs addStruts (x:xs) = x : addStruts xs addStruts [] = [] - isSpacey Space = True + isSpacey Space = True isSpacey (Str ('\160':_)) = True - isSpacey _ = False + isSpacey _ = False -- | Convert inline element to ConTeXt -inlineToConTeXt :: Inline -- ^ Inline to convert - -> State WriterState Doc +inlineToConTeXt :: PandocMonad m + => Inline -- ^ Inline to convert + -> WM m Doc inlineToConTeXt (Emph lst) = do contents <- inlineListToConTeXt lst return $ braces $ "\\em " <> contents @@ -338,8 +401,10 @@ inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula" <> space inlineToConTeXt (RawInline "context" str) = return $ text str inlineToConTeXt (RawInline "tex" str) = return $ text str -inlineToConTeXt (RawInline _ _) = return empty -inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr +inlineToConTeXt il@(RawInline _ _) = do + report $ InlineNotRendered il + return empty +inlineToConTeXt LineBreak = return $ text "\\crlf" <> cr inlineToConTeXt SoftBreak = do wrapText <- gets (writerWrapText . stOptions) return $ case wrapText of @@ -348,7 +413,7 @@ inlineToConTeXt SoftBreak = do WrapPreserve -> cr inlineToConTeXt Space = return space -- Handle HTML-like internal document references to sections -inlineToConTeXt (Link _ txt (('#' : ref), _)) = do +inlineToConTeXt (Link _ txt ('#' : ref, _)) = do opts <- gets stOptions contents <- inlineListToConTeXt txt let ref' = toLabel $ stringToConTeXt opts ref @@ -374,7 +439,7 @@ inlineToConTeXt (Link _ txt (src, _)) = do inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" - in case (dimension dir attr) of + in case dimension dir attr of Just (Pixel a) -> [d <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> @@ -397,84 +462,104 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents let codeBlock x@(CodeBlock _ _) = [x] - codeBlock _ = [] + codeBlock _ = [] let codeBlocks = query codeBlock contents return $ if null codeBlocks then text "\\footnote{" <> nest 2 contents' <> char '}' else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" inlineToConTeXt (Span (_,_,kvs) ils) = do + mblang <- fromBCP47 (lookup "lang" kvs) let wrapDir txt = case lookup "dir" kvs of Just "rtl" -> braces $ "\\righttoleft " <> txt Just "ltr" -> braces $ "\\lefttoright " <> txt _ -> txt - wrapLang txt = case lookup "lang" kvs of - Just lng -> "\\start\\language[" <> text (fromBcp47' lng) + wrapLang txt = case mblang of + Just lng -> "\\start\\language[" <> text lng <> "]" <> txt <> "\\stop " Nothing -> txt - fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils + (wrapLang . wrapDir) <$> inlineListToConTeXt ils -- | Craft the section header, inserting the section reference, if supplied. -sectionHeader :: Attr +sectionHeader :: PandocMonad m + => Attr -> Int -> [Inline] - -> State WriterState Doc -sectionHeader (ident,classes,_) hdrLevel lst = do + -> WM m Doc +sectionHeader (ident,classes,kvs) hdrLevel lst = do + opts <- gets stOptions contents <- inlineListToConTeXt lst - st <- get - let opts = stOptions st + levelText <- sectionLevelToText opts (ident,classes,kvs) hdrLevel + let ident' = if null ident + then empty + else "reference=" <> braces (text (toLabel ident)) + let contents' = if contents == empty + then empty + else "title=" <> braces contents + let options = if keys == empty || levelText == empty + then empty + else brackets keys + where keys = hcat $ intersperse "," $ filter (empty /=) [contents', ident'] + let starter = if writerSectionDivs opts + then "\\start" + else "\\" + return $ starter <> levelText <> options <> blankline + +-- | Craft the section footer +sectionFooter :: PandocMonad m => Attr -> Int -> WM m Doc +sectionFooter attr hdrLevel = do + opts <- gets stOptions + levelText <- sectionLevelToText opts attr hdrLevel + return $ if writerSectionDivs opts + then "\\stop" <> levelText <> blankline + else empty + +-- | Generate a textual representation of the section level +sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m Doc +sectionLevelToText opts (_,classes,_) hdrLevel = do let level' = case writerTopLevelDivision opts of TopLevelPart -> hdrLevel - 2 TopLevelChapter -> hdrLevel - 1 TopLevelSection -> hdrLevel TopLevelDefault -> hdrLevel - let ident' = toLabel ident let (section, chapter) = if "unnumbered" `elem` classes then (text "subject", text "title") else (text "section", text "chapter") return $ case level' of - -1 -> text "\\part" <> braces contents - 0 -> char '\\' <> chapter <> braces contents - n | n >= 1 && n <= 5 -> char '\\' - <> text (concat (replicate (n - 1) "sub")) - <> section - <> (if (not . null) ident' - then brackets (text ident') - else empty) - <> braces contents - <> blankline - _ -> contents <> blankline - -fromBcp47' :: String -> String -fromBcp47' = fromBcp47 . splitBy (=='-') + -1 -> text "part" + 0 -> chapter + n | n >= 1 -> text (concat (replicate (n - 1) "sub")) + <> section + _ -> empty -- cannot happen + +fromBCP47 :: PandocMonad m => Maybe String -> WM m (Maybe String) +fromBCP47 mbs = fromBCP47' <$> toLang mbs -- Takes a list of the constituents of a BCP 47 language code -- and irons out ConTeXt's exceptions -- https://tools.ietf.org/html/bcp47#section-2.1 -- http://wiki.contextgarden.net/Language_Codes -fromBcp47 :: [String] -> String -fromBcp47 [] = "" -fromBcp47 ("ar":"SY":_) = "ar-sy" -fromBcp47 ("ar":"IQ":_) = "ar-iq" -fromBcp47 ("ar":"JO":_) = "ar-jo" -fromBcp47 ("ar":"LB":_) = "ar-lb" -fromBcp47 ("ar":"DZ":_) = "ar-dz" -fromBcp47 ("ar":"MA":_) = "ar-ma" -fromBcp47 ("de":"1901":_) = "deo" -fromBcp47 ("de":"DE":_) = "de-de" -fromBcp47 ("de":"AT":_) = "de-at" -fromBcp47 ("de":"CH":_) = "de-ch" -fromBcp47 ("el":"poly":_) = "agr" -fromBcp47 ("en":"US":_) = "en-us" -fromBcp47 ("en":"GB":_) = "en-gb" -fromBcp47 ("grc":_) = "agr" -fromBcp47 x = fromIso $ head x - where - fromIso "el" = "gr" - fromIso "eu" = "ba" - fromIso "he" = "il" - fromIso "jp" = "ja" - fromIso "uk" = "ua" - fromIso "vi" = "vn" - fromIso "zh" = "cn" - fromIso l = l +fromBCP47' :: Maybe Lang -> Maybe String +fromBCP47' (Just (Lang "ar" _ "SY" _) ) = Just "ar-sy" +fromBCP47' (Just (Lang "ar" _ "IQ" _) ) = Just "ar-iq" +fromBCP47' (Just (Lang "ar" _ "JO" _) ) = Just "ar-jo" +fromBCP47' (Just (Lang "ar" _ "LB" _) ) = Just "ar-lb" +fromBCP47' (Just (Lang "ar" _ "DZ" _) ) = Just "ar-dz" +fromBCP47' (Just (Lang "ar" _ "MA" _) ) = Just "ar-ma" +fromBCP47' (Just (Lang "de" _ _ ["1901"]) ) = Just "deo" +fromBCP47' (Just (Lang "de" _ "DE" _) ) = Just "de-de" +fromBCP47' (Just (Lang "de" _ "AT" _) ) = Just "de-at" +fromBCP47' (Just (Lang "de" _ "CH" _) ) = Just "de-ch" +fromBCP47' (Just (Lang "el" _ _ ["poly"]) ) = Just "agr" +fromBCP47' (Just (Lang "en" _ "US" _) ) = Just "en-us" +fromBCP47' (Just (Lang "en" _ "GB" _) ) = Just "en-gb" +fromBCP47' (Just (Lang "grc"_ _ _) ) = Just "agr" +fromBCP47' (Just (Lang "el" _ _ _) ) = Just "gr" +fromBCP47' (Just (Lang "eu" _ _ _) ) = Just "ba" +fromBCP47' (Just (Lang "he" _ _ _) ) = Just "il" +fromBCP47' (Just (Lang "jp" _ _ _) ) = Just "ja" +fromBCP47' (Just (Lang "uk" _ _ _) ) = Just "ua" +fromBCP47' (Just (Lang "vi" _ _ _) ) = Just "vn" +fromBCP47' (Just (Lang "zh" _ _ _) ) = Just "cn" +fromBCP47' (Just (Lang l _ _ _) ) = Just l +fromBCP47' Nothing = Nothing |