{-
pandoc-crossref is a pandoc filter for numbering figures,
equations, tables and cross-references to them.
Copyright (C) 2015  Nikolay Yakimov <root@livid.pp.ru>

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
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-}

{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.CrossRef.Util.CustomLabels (customLabel, customHeadingLabel) where

import qualified Data.Text as T
import Text.Numeral.Roman
import Text.Pandoc.CrossRef.Util.Meta
import Text.Pandoc.Definition

customLabel :: Meta -> T.Text -> Int -> Maybe T.Text
customLabel :: Meta -> Text -> Int -> Maybe Text
customLabel Meta
meta Text
ref Int
i
  | Text
refLabel <- (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') Text
ref
  , Just MetaValue
cl <- Text -> Meta -> Maybe MetaValue
lookupMeta (Text
refLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Labels") Meta
meta
  = Int -> Text -> MetaValue -> Maybe Text
mkLabel Int
i (Text
refLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Labels") MetaValue
cl
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

customHeadingLabel :: Meta -> Int -> Int -> Maybe T.Text
customHeadingLabel :: Meta -> Int -> Int -> Maybe Text
customHeadingLabel Meta
meta Int
lvl Int
i
  | Just MetaValue
cl <- (MetaValue -> Maybe MetaValue)
-> Text -> Meta -> Int -> Maybe MetaValue
forall a. Default a => (MetaValue -> a) -> Text -> Meta -> Int -> a
getMetaList MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just Text
"secLevelLabels" Meta
meta (Int
lvlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  = Int -> Text -> MetaValue -> Maybe Text
mkLabel Int
i Text
"secLevelLabels" MetaValue
cl
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

mkLabel :: Int -> T.Text -> MetaValue -> Maybe T.Text
mkLabel :: Int -> Text -> MetaValue -> Maybe Text
mkLabel Int
i Text
n MetaValue
lt
  | MetaList [MetaValue]
_ <- MetaValue
lt
  , Just Text
val <- Text -> MetaValue -> Text
toString Text
n (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MetaValue -> Maybe MetaValue
getList (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MetaValue
lt
  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val
  | Text -> MetaValue -> Text
toString Text
n MetaValue
lt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"arabic"
  = Maybe Text
forall a. Maybe a
Nothing
  | Text -> MetaValue -> Text
toString Text
n MetaValue
lt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"roman"
  = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall n. (Ord n, Num n) => n -> Text
toRoman Int
i
  | Text -> MetaValue -> Text
toString Text
n MetaValue
lt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"lowercase roman"
  = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall n. (Ord n, Num n) => n -> Text
toRoman Int
i
  | Just (Char
startWith, Text
_) <- Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Maybe Text -> Maybe (Char, Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripPrefix Text
"alpha " (Text -> MetaValue -> Text
toString Text
n MetaValue
lt)
  = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Char -> Text) -> Char -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Maybe Text) -> Char -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char
startWith..] [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  | Bool
otherwise = [Char] -> Maybe Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Text) -> [Char] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown numeration type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ MetaValue -> [Char]
forall a. Show a => a -> [Char]
show MetaValue
lt