{-
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, MultiParamTypeClasses #-}
module Text.Pandoc.CrossRef.Util.Template
  ( Template
  , BlockTemplate
  , makeTemplate
  , makeIndexedTemplate
  , applyTemplate
  , applyTemplate'
  ) where

import Control.Applicative
import Data.Data
import qualified Data.Map as M hiding (fromList, singleton, toList)
import qualified Data.Text as T
import Text.Pandoc.Builder
import Text.Pandoc.CrossRef.Util.Meta
import Text.Pandoc.Generic
import Text.Read

type VarFunc = T.Text -> Maybe MetaValue
newtype Template = Template (VarFunc -> [Inline])
newtype BlockTemplate = BlockTemplate (VarFunc -> [Block])

class Data a => MkTemplate a b where
  mkTemplate :: (VarFunc -> [a]) -> b
  applyTemplate' :: M.Map T.Text [Inline] -> b -> [a]

instance MkTemplate Inline Template where
  mkTemplate :: (VarFunc -> [Inline]) -> Template
mkTemplate = (VarFunc -> [Inline]) -> Template
Template
  applyTemplate' :: Map Text [Inline] -> Template -> [Inline]
applyTemplate' Map Text [Inline]
vars (Template VarFunc -> [Inline]
g) = VarFunc -> [Inline]
g (Map Text [Inline] -> VarFunc
internalVars Map Text [Inline]
vars)

instance MkTemplate Block BlockTemplate where
  mkTemplate :: (VarFunc -> [Block]) -> BlockTemplate
mkTemplate = (VarFunc -> [Block]) -> BlockTemplate
BlockTemplate
  applyTemplate' :: Map Text [Inline] -> BlockTemplate -> [Block]
applyTemplate' Map Text [Inline]
vars (BlockTemplate VarFunc -> [Block]
g) = VarFunc -> [Block]
g (Map Text [Inline] -> VarFunc
internalVars Map Text [Inline]
vars)

makeTemplate :: MkTemplate a b => Meta -> [a] -> b
makeTemplate :: forall a b. MkTemplate a b => Meta -> [a] -> b
makeTemplate Meta
dtv [a]
xs' = forall a b. MkTemplate a b => (VarFunc -> [a]) -> b
mkTemplate forall a b. (a -> b) -> a -> b
$ \VarFunc
vf -> VarFunc -> [a] -> [a]
scan (\Text
var -> VarFunc
vf Text
var forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Meta -> Maybe MetaValue
lookupMeta Text
var Meta
dtv) [a]
xs'
  where
  scan :: VarFunc -> [a] -> [a]
scan = forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarFunc -> [Inline] -> [Inline]
go
  go :: VarFunc -> [Inline] -> [Inline]
go VarFunc
vf (x :: Inline
x@(Math MathType
DisplayMath Text
var):[Inline]
xs)
    | (Text
vn, Text
idxBr) <- (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/=Char
'[') Text
var
    , Bool -> Bool
not (Text -> Bool
T.null Text
idxBr)
    , Text -> Char
T.last Text
idxBr forall a. Eq a => a -> a -> Bool
== Char
']'
    = let idxVar :: Text
idxVar = Int -> Text -> Text
T.drop Int
1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
']') Text
idxBr
          idx :: Maybe Int
idx = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MetaValue -> Text
toString (Text
"index variable " forall a. Semigroup a => a -> a -> a
<> Text
idxVar) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VarFunc
vf Text
idxVar
          arr :: Maybe MetaValue
arr = do
            Int
i <- Maybe Int
idx
            MetaValue
v <- Text -> Meta -> Maybe MetaValue
lookupMeta Text
vn Meta
dtv
            Int -> MetaValue -> Maybe MetaValue
getList Int
i MetaValue
v
      in forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
fromList (Text -> Maybe MetaValue -> [Inline] -> [Inline]
replaceVar Text
var Maybe MetaValue
arr [Inline
x]) forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> Many a
fromList [Inline]
xs
    | Bool
otherwise = forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
fromList (Text -> Maybe MetaValue -> [Inline] -> [Inline]
replaceVar Text
var (VarFunc
vf Text
var) [Inline
x]) forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> Many a
fromList [Inline]
xs
  go VarFunc
_ (Inline
x:[Inline]
xs) = forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
singleton Inline
x forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> Many a
fromList [Inline]
xs
  go VarFunc
_ [] = []
  replaceVar :: Text -> Maybe MetaValue -> [Inline] -> [Inline]
replaceVar Text
var Maybe MetaValue
val [Inline]
def' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Inline]
def' (Text -> MetaValue -> [Inline]
toInlines (Text
"variable " forall a. Semigroup a => a -> a -> a
<> Text
var)) Maybe MetaValue
val

makeIndexedTemplate :: T.Text -> Meta -> T.Text -> Template
makeIndexedTemplate :: Text -> Meta -> Text -> Template
makeIndexedTemplate Text
name Meta
meta Text
subname =
  forall a b. MkTemplate a b => Meta -> [a] -> b
makeTemplate Meta
meta forall a b. (a -> b) -> a -> b
$ case Text -> Meta -> Maybe MetaValue
lookupMeta Text
name Meta
meta of
    Just (MetaMap Map Text MetaValue
m) -> case Text -> Meta -> Maybe MetaValue
lookupMeta Text
subname (Map Text MetaValue -> Meta
Meta Map Text MetaValue
m) of
      Just MetaValue
x -> Text -> MetaValue -> [Inline]
toInlines Text
name MetaValue
x
      Maybe MetaValue
Nothing -> Text -> Meta -> [Inline]
getMetaInlines Text
"default" (Map Text MetaValue -> Meta
Meta Map Text MetaValue
m)
    Just MetaValue
x -> Text -> MetaValue -> [Inline]
toInlines Text
name MetaValue
x
    Maybe MetaValue
Nothing -> []

internalVars :: M.Map T.Text [Inline] -> T.Text -> Maybe MetaValue
internalVars :: Map Text [Inline] -> VarFunc
internalVars Map Text [Inline]
vars Text
x = [Inline] -> MetaValue
MetaInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
x Map Text [Inline]
vars

applyTemplate :: MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate :: forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate [Inline]
i [Inline]
t =
  forall a b. MkTemplate a b => Map Text [Inline] -> b -> [a]
applyTemplate' (forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList [(Text
"i", [Inline]
i), (Text
"t", [Inline]
t)])