{-
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 FlexibleContexts, Rank2Types #-}
module Text.Pandoc.CrossRef.Util.Meta (
    getMetaList
  , getMetaBool
  , getMetaInlines
  , getMetaBlock
  , getMetaString
  , getList
  , toString
  , toInlines
  , tryCapitalizeM
  ) where

import Data.Default
import qualified Data.Text as T
import Text.Pandoc.Builder
import Text.Pandoc.CrossRef.Util.Util
import Text.Pandoc.Shared hiding (capitalize)
import Text.Pandoc.Walk

getMetaList :: (Default a) => (MetaValue -> a) -> T.Text -> Meta -> Int -> a
getMetaList :: forall a. Default a => (MetaValue -> a) -> Text -> Meta -> Int -> a
getMetaList MetaValue -> a
f Text
name Meta
meta Int
i = a -> (MetaValue -> a) -> Maybe MetaValue -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
forall a. Default a => a
def MetaValue -> a
f (Maybe MetaValue -> a) -> Maybe MetaValue -> a
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
name Meta
meta Maybe MetaValue
-> (MetaValue -> Maybe MetaValue) -> Maybe MetaValue
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> MetaValue -> Maybe MetaValue
getList Int
i

getMetaBool :: T.Text -> Meta -> Bool
getMetaBool :: Text -> Meta -> Bool
getMetaBool = (Text -> MetaValue -> Bool) -> Text -> Meta -> Bool
forall b. Def b => (Text -> MetaValue -> b) -> Text -> Meta -> b
getScalar Text -> MetaValue -> Bool
toBool

getMetaInlines :: T.Text -> Meta -> [Inline]
getMetaInlines :: Text -> Meta -> [Inline]
getMetaInlines = (Text -> MetaValue -> [Inline]) -> Text -> Meta -> [Inline]
forall b. Def b => (Text -> MetaValue -> b) -> Text -> Meta -> b
getScalar Text -> MetaValue -> [Inline]
toInlines

getMetaBlock :: T.Text -> Meta -> [Block]
getMetaBlock :: Text -> Meta -> [Block]
getMetaBlock = (Text -> MetaValue -> [Block]) -> Text -> Meta -> [Block]
forall b. Def b => (Text -> MetaValue -> b) -> Text -> Meta -> b
getScalar Text -> MetaValue -> [Block]
toBlocks

getMetaString :: T.Text -> Meta -> T.Text
getMetaString :: Text -> Meta -> Text
getMetaString = (Text -> MetaValue -> Text) -> Text -> Meta -> Text
forall b. Def b => (Text -> MetaValue -> b) -> Text -> Meta -> b
getScalar Text -> MetaValue -> Text
toString

getScalar :: Def b => (T.Text -> MetaValue -> b) -> T.Text -> Meta -> b
getScalar :: forall b. Def b => (Text -> MetaValue -> b) -> Text -> Meta -> b
getScalar Text -> MetaValue -> b
conv Text
name Meta
meta = b -> (MetaValue -> b) -> Maybe MetaValue -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
forall a. Def a => a
def' (Text -> MetaValue -> b
conv Text
name) (Maybe MetaValue -> b) -> Maybe MetaValue -> b
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
name Meta
meta

class Def a where
  def' :: a

instance Def Bool where
  def' :: Bool
def' = Bool
False

instance Def [a] where
  def' :: [a]
def' = []

instance Def T.Text where
  def' :: Text
def' = Text
T.empty

unexpectedError :: forall a. String -> T.Text -> MetaValue -> a
unexpectedError :: forall a. String -> Text -> MetaValue -> a
unexpectedError String
e Text
n MetaValue
x = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in metadata field " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MetaValue -> String
g MetaValue
x
  where
    g :: MetaValue -> String
g (MetaBlocks [Block]
_) = String
"blocks"
    g (MetaString Text
_) = String
"string"
    g (MetaInlines [Inline]
_) = String
"inlines"
    g (MetaBool Bool
_) = String
"bool"
    g (MetaMap Map Text MetaValue
_) = String
"map"
    g (MetaList [MetaValue]
_) = String
"list"

toInlines :: T.Text -> MetaValue -> [Inline]
toInlines :: Text -> MetaValue -> [Inline]
toInlines Text
_ (MetaBlocks [Block]
s) = [Block] -> [Inline]
blocksToInlines [Block]
s
toInlines Text
_ (MetaInlines [Inline]
s) = [Inline]
s
toInlines Text
_ (MetaString Text
s) = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text Text
s
toInlines Text
n MetaValue
x = String -> Text -> MetaValue -> [Inline]
forall a. String -> Text -> MetaValue -> a
unexpectedError String
"inlines" Text
n MetaValue
x

toBool :: T.Text -> MetaValue -> Bool
toBool :: Text -> MetaValue -> Bool
toBool Text
_ (MetaBool Bool
b) = Bool
b
toBool Text
n MetaValue
x = String -> Text -> MetaValue -> Bool
forall a. String -> Text -> MetaValue -> a
unexpectedError String
"bool" Text
n MetaValue
x

toBlocks :: T.Text -> MetaValue -> [Block]
toBlocks :: Text -> MetaValue -> [Block]
toBlocks Text
_ (MetaBlocks [Block]
bs) = [Block]
bs
toBlocks Text
_ (MetaInlines [Inline]
ils) = [[Inline] -> Block
Plain [Inline]
ils]
toBlocks Text
_ (MetaString Text
s) = Many Block -> [Block]
forall a. Many a -> [a]
toList (Many Block -> [Block]) -> Many Block -> [Block]
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text Text
s
toBlocks Text
n MetaValue
x = String -> Text -> MetaValue -> [Block]
forall a. String -> Text -> MetaValue -> a
unexpectedError String
"blocks" Text
n MetaValue
x

toString :: T.Text -> MetaValue -> T.Text
toString :: Text -> MetaValue -> Text
toString Text
_ (MetaString Text
s) = Text
s
toString Text
_ (MetaBlocks [Block]
b) = [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
b
toString Text
_ (MetaInlines [Inline]
i) = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
i
toString Text
n MetaValue
x = String -> Text -> MetaValue -> Text
forall a. String -> Text -> MetaValue -> a
unexpectedError String
"string" Text
n MetaValue
x

getList :: Int -> MetaValue -> Maybe MetaValue
getList :: Int -> MetaValue -> Maybe MetaValue
getList Int
i (MetaList [MetaValue]
l) = [MetaValue]
l [MetaValue] -> Int -> Maybe MetaValue
forall {a}. [a] -> Int -> Maybe a
!!? Int
i
  where
    [a]
list !!? :: [a] -> Int -> Maybe a
!!? Int
index | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a]
list [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
index
                   | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
list = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
list
                   | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
getList Int
_ MetaValue
x = MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just MetaValue
x

tryCapitalizeM :: (Functor m, Monad m, Walkable Inline a, Default a, Eq a) =>
        (T.Text -> m a) -> T.Text -> Bool -> m a
tryCapitalizeM :: forall (m :: * -> *) a.
(Functor m, Monad m, Walkable Inline a, Default a, Eq a) =>
(Text -> m a) -> Text -> Bool -> m a
tryCapitalizeM Text -> m a
f Text
varname Bool
capitalize
  | Bool
capitalize = do
    a
res <- Text -> m a
f (Text -> Text
capitalizeFirst Text
varname)
    case a
res of
      a
xs | a
xs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Default a => a
def -> Text -> m a
f Text
varname m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Inline -> m Inline) -> a -> m a
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> a -> m a
walkM Inline -> m Inline
forall {m :: * -> *}. Monad m => Inline -> m Inline
capStrFst
         | Bool
otherwise -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
xs
  | Bool
otherwise  = Text -> m a
f Text
varname
  where
    capStrFst :: Inline -> m Inline
capStrFst (Str Text
s) = Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> Text
capitalizeFirst Text
s
    capStrFst Inline
x = Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x