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

This module implements parser of the shortcut links that are introduced in the
[shortcut-links](https://hackage.haskell.org/package/shortcut-links) package.

The markdown example of the shortcut link:

@
[This project]\(\@github(Kowainik):hakyll-shortcut-links)
@

The implemented parser should parse the @url@ part of the link.
In this example the parsed links would look like this:

>>> parseShortcut "@github(Kowainik):hakyll-shortcut-links"
Right ("github", Just "Kowainik", Just "hakyll-shortcut-links")

-}

module Hakyll.ShortcutLinks.Parser
       ( parseShortcut
       ) where

import Data.Text (Text)
import Text.Parsec (Parsec, anyChar, many1, noneOf, optionMaybe, parse, (<|>))
import Text.Parsec.Char (alphaNum, char)

import qualified Data.Text as T


type Parser = Parsec Text ()

{- | Parses a shortcut link. Allowed formats:

@
\@name
\@name:text
\@name(option)
\@name(option):text
@
-}
parseShortcut :: Text -> Either String (Text, Maybe Text, Maybe Text)
parseShortcut :: Text -> Either String (Text, Maybe Text, Maybe Text)
parseShortcut = (ParseError -> Either String (Text, Maybe Text, Maybe Text))
-> ((Text, Maybe Text, Maybe Text)
    -> Either String (Text, Maybe Text, Maybe Text))
-> Either ParseError (Text, Maybe Text, Maybe Text)
-> Either String (Text, Maybe Text, Maybe Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String (Text, Maybe Text, Maybe Text)
forall a b. a -> Either a b
Left (String -> Either String (Text, Maybe Text, Maybe Text))
-> (ParseError -> String)
-> ParseError
-> Either String (Text, Maybe Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) (Text, Maybe Text, Maybe Text)
-> Either String (Text, Maybe Text, Maybe Text)
forall a b. b -> Either a b
Right (Either ParseError (Text, Maybe Text, Maybe Text)
 -> Either String (Text, Maybe Text, Maybe Text))
-> (Text -> Either ParseError (Text, Maybe Text, Maybe Text))
-> Text
-> Either String (Text, Maybe Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () (Text, Maybe Text, Maybe Text)
-> String
-> Text
-> Either ParseError (Text, Maybe Text, Maybe Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () (Text, Maybe Text, Maybe Text)
p String
""
  where
    name :: Parser Text
    name :: Parser Text
name = String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')

    option, text :: Parser Text
    option :: Parser Text
option = (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT Text () Identity String -> Parser Text)
-> ParsecT Text () Identity String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
')']) ParsecT Text () Identity String
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
    text :: Parser Text
text   = (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT Text () Identity String -> Parser Text)
-> ParsecT Text () Identity String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

    p :: Parser (Text, Maybe Text, Maybe Text)
    p :: Parsec Text () (Text, Maybe Text, Maybe Text)
p = do
        Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
        (,,) (Text
 -> Maybe Text -> Maybe Text -> (Text, Maybe Text, Maybe Text))
-> Parser Text
-> ParsecT
     Text
     ()
     Identity
     (Maybe Text -> Maybe Text -> (Text, Maybe Text, Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
name
             ParsecT
  Text
  ()
  Identity
  (Maybe Text -> Maybe Text -> (Text, Maybe Text, Maybe Text))
-> ParsecT Text () Identity (Maybe Text)
-> ParsecT
     Text () Identity (Maybe Text -> (Text, Maybe Text, Maybe Text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> ParsecT Text () Identity (Maybe Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe Parser Text
option
             ParsecT
  Text () Identity (Maybe Text -> (Text, Maybe Text, Maybe Text))
-> ParsecT Text () Identity (Maybe Text)
-> Parsec Text () (Text, Maybe Text, Maybe Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> ParsecT Text () Identity (Maybe Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe Parser Text
text