{-# LANGUAGE FlexibleContexts #-}

{- |
Copyright:  (c) 2019-2020 Kowainik
License:    MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This package allows to use [shortcut-links](https://hackage.haskell.org/package/shortcut-links)
package in websites generated by [hakyll](https://hackage.haskell.org/package/hakyll).

The flexible interface allows to use the supported huge collection of shortcuts
along with using custom ones.

Here is a few examples of the `@github` shortcut:

- Link to a user:

+----------------------------------------+----------------------------------------------------+
|              Shortcut                  |                Plain markdown                      |
+========================================+====================================================+
| @[foo]\(\@github)@                     | @[foo]\(https:\/\/github.com\/foo)@                |
+----------------------------------------+----------------------------------------------------+
| @[foo Github profile]\(\@github(foo))@ | @[foo Github profile]\(https:\/\/github.com\/foo)@ |
+----------------------------------------+----------------------------------------------------+

- Link to a repository:

+---------------------------------------+----------------------------------------------------+
|             Shortcut                  |               Plain markdown                       |
+=======================================+====================================================+
| @[bar]\(\@github:foo)@                | @[bar]\(https:\/\/github.com\/foo\/bar)@           |
+---------------------------------------+----------------------------------------------------+
| @[Github Source]\(\@github(foo):bar)@ | @[Github Source]\(https:\/\/github.com\/foo\/bar)@ |
+---------------------------------------+----------------------------------------------------+
-}

module Hakyll.ShortcutLinks
       ( -- * Pandoc functions
         -- $pandoc
         applyShortcuts
       , applyAllShortcuts

         -- * Hakyll functions
         -- $hakyll
       , shortcutLinksCompiler
       , allShortcutLinksCompiler

         -- * Shortcut-links reexports
         -- $sh
       , module Sh
         -- $allSh
       , module ShortcutLinks.All
       ) where

import Control.Monad.Except (MonadError (..))
import Data.Text (Text)
import Hakyll (Compiler, Item, defaultHakyllReaderOptions, defaultHakyllWriterOptions,
               pandocCompilerWithTransformM)
import ShortcutLinks (Result (..), Shortcut, allShortcuts, useShortcutFrom)
import Text.Pandoc.Generic (bottomUpM)

import Hakyll.ShortcutLinks.Parser (parseShortcut)

-- exports
import ShortcutLinks as Sh
import ShortcutLinks.All

import qualified Text.Pandoc.Definition as Pandoc


{- $pandoc
Functions to transform 'Pandoc.Pandoc' documents. These functions modify
markdown links to the extended links.

These are the most generic functions. They work inside the monad @m@ that has
@'MonadError' ['String']@ instance.
You can use the pure version of these function because there's 'MonadError'
instance for 'Either':

@
applyShorcuts :: [(['Text'], 'Shortcut')] -> 'Pandoc.Pandoc' -> 'Either' ['String'] 'Pandoc.Pandoc'
applyAllShorcuts :: 'Pandoc.Pandoc' -> 'Either' ['String'] 'Pandoc.Pandoc'
@

If you have your own @hakyll@ options for your custom pandoc compiler, you can
use this function like this:

@
'pandocCompilerWithTransformM'
    myHakyllReaderOptions
    myHakyllWriterOptions
    ('applyShortcuts' myShortcuts)
@


-}

{- | Modifies markdown shortcut links to the extended version and returns
'Pandoc.Pandoc' with the complete links instead.

Unlike 'applyAllShortcuts' which uses the hardcoded list of the possible
shortcuts (see 'allShortcuts'), the 'applyShortcuts' function uses the given
list of custom provided shortcuts.
For your help you can use 'ShortcutLinks.All' module to see all available
shortcuts.

If you want to add a couple of custom shortcuts to the list of already existing
shortcuts you can do it in the following way:

@
(["hk", "hackage"], 'hackage') : 'allShortcuts'
@
-}
applyShortcuts
    :: forall m . MonadError [String] m
    => [([Text], Shortcut)]  -- ^ Shortcuts
    -> Pandoc.Pandoc         -- ^ Pandoc document that possibly contains shortened links
    -> m Pandoc.Pandoc       -- ^ Result pandoc document with shorcuts expanded
applyShortcuts :: [([Text], Shortcut)] -> Pandoc -> m Pandoc
applyShortcuts shortcuts :: [([Text], Shortcut)]
shortcuts = (Inline -> m Inline) -> Pandoc -> m Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM Inline -> m Inline
applyLink
  where
    applyLink :: Pandoc.Inline -> m Pandoc.Inline
    applyLink :: Inline -> m Inline
applyLink l :: Inline
l@(Pandoc.Link attr :: Attr
attr inl :: [Inline]
inl (url :: Text
url, title :: Text
title)) = case Text -> Either String (Text, Maybe Text, Maybe Text)
parseShortcut Text
url of
        Right (name :: Text
name, option :: Maybe Text
option, text :: Maybe Text
text) -> m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Inline] -> m Text
checkTitle [Inline]
inl) Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
text m Text -> (Text -> m Inline) -> m Inline
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \txtTitle :: Text
txtTitle ->
            case [([Text], Shortcut)] -> Text -> Shortcut
useShortcutFrom [([Text], Shortcut)]
shortcuts Text
name Maybe Text
option Text
txtTitle of
                Success link :: Text
link -> Inline -> m Inline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Target -> Inline
Pandoc.Link Attr
attr [Inline]
inl (Text
link, Text
title)
                Warning ws :: [String]
ws _ -> [String] -> m Inline
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [String]
ws
                Failure msg :: String
msg  -> [String] -> m Inline
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [String
msg]
        Left _ -> Inline -> m Inline
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
l  -- the link is not shortcut
    applyLink other :: Inline
other = Inline -> m Inline
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
other

    checkTitle :: [Pandoc.Inline] -> m Text
    checkTitle :: [Inline] -> m Text
checkTitle = \case
        [] -> [String] -> m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ["Empty shortcut link title arguments"]
        [Pandoc.Str s :: Text
s] -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
        _ -> [String] -> m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ["Shortcut title is not a single string element"]

{- |  Modifies markdown shortcut links to the extended version and returns
'Pandoc.Pandoc' with the complete links instead.

Similar to 'applyShortcuts' but uses 'allShortcuts' as a list of shortcuts to
parse against.
-}
applyAllShortcuts :: MonadError [String] m => Pandoc.Pandoc -> m Pandoc.Pandoc
applyAllShortcuts :: Pandoc -> m Pandoc
applyAllShortcuts = [([Text], Shortcut)] -> Pandoc -> m Pandoc
forall (m :: * -> *).
MonadError [String] m =>
[([Text], Shortcut)] -> Pandoc -> m Pandoc
applyShortcuts [([Text], Shortcut)]
allShortcuts

{- $hakyll
Functions to integrate shortcut links to [hakyll](http://hackage.haskell.org/package/hakyll).

@hakyll-shortcut-links@ provides out-of-the-box 'Compiler's that translate
markdown documents with shortcut links into the documents with extended links.

Usually you would want to use this feature on your blog post markdown files.
Assuming that you already have similar code for it:

@
match "blog/*" $ do
    route $ setExtension "html"
    compile $
        __pandocCompiler__
            >>= loadAndApplyTemplate "templates/post.html" defaultContext
            >>= relativizeUrls
@

All that you would need to do is to replace 'Hakyll.pandocCompiler' with
'shortcutLinksCompiler' or 'allShortcutLinksCompiler':

@
match "blog/*" $ do
    route $ setExtension "html"
    compile $
        __'allShortcutLinksCompiler'__
            >>= loadAndApplyTemplate "templates/post.html" defaultContext
            >>= relativizeUrls
@

-}

{- | Our own pandoc compiler which parses shortcut links automatically.
It takes a custom list of shortcut links to be used in the document.
-}
shortcutLinksCompiler :: [([Text], Shortcut)] -> Compiler (Item String)
shortcutLinksCompiler :: [([Text], Shortcut)] -> Compiler (Item String)
shortcutLinksCompiler = ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Compiler (Item String)
pandocCompilerWithTransformM
    ReaderOptions
defaultHakyllReaderOptions
    WriterOptions
defaultHakyllWriterOptions
    ((Pandoc -> Compiler Pandoc) -> Compiler (Item String))
-> ([([Text], Shortcut)] -> Pandoc -> Compiler Pandoc)
-> [([Text], Shortcut)]
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Text], Shortcut)] -> Pandoc -> Compiler Pandoc
forall (m :: * -> *).
MonadError [String] m =>
[([Text], Shortcut)] -> Pandoc -> m Pandoc
applyShortcuts

{- | Our own pandoc compiler which parses shortcut links automatically. Same as
'shortcutLinksCompiler' but passes 'allShortcuts' as an argument.
-}
allShortcutLinksCompiler :: Compiler (Item String)
allShortcutLinksCompiler :: Compiler (Item String)
allShortcutLinksCompiler = [([Text], Shortcut)] -> Compiler (Item String)
shortcutLinksCompiler [([Text], Shortcut)]
allShortcuts

{- $sh
This is the module from @shortcut-links@ library that introduces the functions
that by given shortcuts creates the 'Result'ing URL (if possible).
-}

{- $allSh
This module stores a large number of supported 'Shortcut's.
It also reexports a useful function 'allShortcuts' that is a list of all
shortcuts, together with suggested names for them.

In @hakyll-shortcut-links@ we are exporting both functions that work with the
standard list of 'allShortcuts', but also we provide the option to use your own
lists of shortcuts (including self-created ones).

For example, if you want to use just 'github' and 'hackage' shortcuts you can
create the following list:

@
(["github"], github) : (["hackage"], hackage) : []
@

If you want to create your own shortcut that is not included in
"ShortcutLinks.All" module you can achieve that implementing the following
function:

@
kowainik :: 'Shortcut'
kowainik _ text = pure $ "https://kowainik.github.io/posts/" <> text

myShortcuts :: [(['Text'], 'Shortcut')]
myShortcuts = [(["kowainik"], kowainik)]
@

And it would work like this:

@
[blog post]\(@kowainik:2019-02-06-style-guide)

=>

[blog post]\(https:\/\/kowainik.github.io\/posts\/2019-02-06-style-guide)
@
-}