{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Columns
Description : When a code block has the "include" label, treat it as a list of files to include.
Copyright   : (c) Amy de Buitléir, 2023
License     : BSD--3
Maintainer  : amy@nualeargais.ie
Stability   : experimental
Portability : POSIX

See <https://github.com/mhwombat/pandoc-linear-table> for information
on how to use this filter.
-}
module Text.Pandoc.Filters.Include
  (
    transform
  ) where

import Data.Text        qualified as T
import Network.URI (isURI)
import System.FilePath  (combine, isAbsolute, isRelative, takeDirectory)
import Text.Pandoc      qualified as P
import Text.Pandoc.UTF8 qualified as U
import Text.Pandoc.Walk     (walk)

transform :: FilePath -> P.Block -> IO [P.Block]
transform :: FilePath -> Block -> IO [Block]
transform FilePath
d b :: Block
b@(P.CodeBlock (Text
_, [Text]
classes, [(Text, Text)]
kvs) Text
s)
  | Text
"include" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = FilePath -> [(Text, Text)] -> Text -> IO [Block]
doIncludes FilePath
d [(Text, Text)]
kvs Text
s
  | Bool
otherwise         = forall (m :: * -> *) a. Monad m => a -> m a
return [Block
b]
transform FilePath
_ Block
b = forall (m :: * -> *) a. Monad m => a -> m a
return [Block
b]

doIncludes :: FilePath -> [(T.Text, T.Text)] -> T.Text -> IO [P.Block]
doIncludes :: FilePath -> [(Text, Text)] -> Text -> IO [Block]
doIncludes FilePath
d [(Text, Text)]
kvs Text
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> Int -> FilePath -> IO [Block]
doInclude FilePath
d Int
levelAdjustment) [FilePath]
fs
  where fs :: [FilePath]
fs = FilePath -> [FilePath]
lines forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
s
        levelAdjustment :: Int
levelAdjustment = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"level" [(Text, Text)]
kvs of
                            Just Text
v  -> forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
v
                            Maybe Text
Nothing -> Int
0

-- Note: This will terminate automatically when there are no further transformations.
doInclude :: FilePath -> Int -> FilePath -> IO [P.Block]
doInclude :: FilePath -> Int -> FilePath -> IO [Block]
doInclude FilePath
dir Int
levelAdj FilePath
f = do
  let path :: FilePath
path = if FilePath -> Bool
isRelative FilePath
f then FilePath -> FilePath -> FilePath
combine FilePath
dir FilePath
f else FilePath
f
  let includeDir :: FilePath
includeDir = FilePath -> FilePath
takeDirectory FilePath
path
  Pandoc
p <- FilePath -> IO Pandoc
readMarkdownFromFile FilePath
path
  let (P.Pandoc Meta
_ [Block]
bs) = forall a b. Walkable a b => (a -> a) -> b -> b
walk (FilePath -> Inline -> Inline
adjustImagePaths FilePath
includeDir) Pandoc
p
  [Block]
bs' <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> Block -> IO [Block]
transform forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
path) [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Block -> Block
adjustHeaderLevel Int
levelAdj) [Block]
bs'

readMarkdownFromFile :: FilePath -> IO P.Pandoc
readMarkdownFromFile :: FilePath -> IO Pandoc
readMarkdownFromFile FilePath
f = FilePath -> IO Text
U.readFile FilePath
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO Pandoc
parseMarkdown

parseMarkdown :: T.Text -> IO P.Pandoc
parseMarkdown :: Text -> IO Pandoc
parseMarkdown Text
s = forall a. PandocIO a -> IO (Either PandocError a)
P.runIO (forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
P.readMarkdown ReaderOptions
markdownReaderOptions Text
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Either PandocError a -> IO a
P.handleError

markdownReaderOptions :: P.ReaderOptions
markdownReaderOptions :: ReaderOptions
markdownReaderOptions = forall a. Default a => a
P.def { readerStandalone :: Bool
P.readerStandalone = Bool
True,
                                readerExtensions :: Extensions
P.readerExtensions = Extensions
P.pandocExtensions }

adjustHeaderLevel :: Int -> P.Block -> P.Block
adjustHeaderLevel :: Int -> Block -> Block
adjustHeaderLevel Int
n (P.Header Int
m (Text, [Text], [(Text, Text)])
attr [Inline]
xs)
  | Int
m' forall a. Ord a => a -> a -> Bool
<= Int
0   = [Inline] -> Block
P.Para [Inline]
xs
  | Bool
otherwise = Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
P.Header Int
m' (Text, [Text], [(Text, Text)])
attr [Inline]
xs
  where m' :: Int
m' = Int
n forall a. Num a => a -> a -> a
+ Int
m
adjustHeaderLevel Int
_ Block
b = Block
b

adjustImagePaths :: FilePath -> P.Inline -> P.Inline
adjustImagePaths :: FilePath -> Inline -> Inline
adjustImagePaths FilePath
dir (P.Image (Text, [Text], [(Text, Text)])
attr [Inline]
xs (Text
url, Text
title)) = (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
P.Image (Text, [Text], [(Text, Text)])
attr [Inline]
xs (FilePath -> Text -> Text
adjustFilePath FilePath
dir Text
url, Text
title)
adjustImagePaths FilePath
_ Inline
x = Inline
x

adjustFilePath :: FilePath -> T.Text -> T.Text
adjustFilePath :: FilePath -> Text -> Text
adjustFilePath FilePath
dir Text
url
  | FilePath -> Bool
isURI FilePath
s      = Text
url
  | FilePath -> Bool
isAbsolute FilePath
s = Text
url
  | Bool
otherwise    = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
combine FilePath
dir FilePath
s
  where s :: FilePath
s = Text -> FilePath
T.unpack Text
url

{-
Useful for debugging in GHCi

:l Text.Pandoc.Filters.Include
(P.Pandoc _ bs) <- readMarkdownFromFile "test-files/test.md"
concat <$> mapM (transform "test-files") bs
-}