{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Text.MMark.Util
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Internal utilities.
module Text.MMark.Util
  ( asPlainText,
    headerId,
    headerFragment,
  )
where

import Data.Char (isAlphaNum, isSpace)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import Text.MMark.Type
import Text.URI (URI (..))
import qualified Text.URI as URI

-- | Convert a non-empty collection of 'Inline's into their plain text
-- representation. This is used e.g. to render image descriptions.
asPlainText :: NonEmpty Inline -> Text
asPlainText :: NonEmpty Inline -> Text
asPlainText = (Inline -> Text) -> NonEmpty Inline -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Inline -> Text) -> NonEmpty Inline -> Text)
-> (Inline -> Text) -> NonEmpty Inline -> Text
forall a b. (a -> b) -> a -> b
$ \case
  Plain Text
txt -> Text
txt
  Inline
LineBreak -> Text
"\n"
  Emphasis NonEmpty Inline
xs -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  Strong NonEmpty Inline
xs -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  Strikeout NonEmpty Inline
xs -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  Subscript NonEmpty Inline
xs -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  Superscript NonEmpty Inline
xs -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  CodeSpan Text
txt -> Text
txt
  Link NonEmpty Inline
xs URI
_ Maybe Text
_ -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs
  Image NonEmpty Inline
xs URI
_ Maybe Text
_ -> NonEmpty Inline -> Text
asPlainText NonEmpty Inline
xs

-- | Generate value of id attribute for a given header. This is used during
-- rendering and also can be used to get id of a header for linking to it in
-- extensions.
--
-- See also: 'headerFragment'.
headerId :: NonEmpty Inline -> Text
headerId :: NonEmpty Inline -> Text
headerId =
  Text -> [Text] -> Text
T.intercalate Text
"-"
    ([Text] -> Text)
-> (NonEmpty Inline -> [Text]) -> NonEmpty Inline -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
    (Text -> [Text])
-> (NonEmpty Inline -> Text) -> NonEmpty Inline -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (\Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
x)
    (Text -> Text)
-> (NonEmpty Inline -> Text) -> NonEmpty Inline -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
    (Text -> Text)
-> (NonEmpty Inline -> Text) -> NonEmpty Inline -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Inline -> Text
asPlainText

-- | Generate a 'URI' containing only a fragment from its textual
-- representation. Useful for getting URL from id of a header.
headerFragment :: Text -> URI
headerFragment :: Text -> URI
headerFragment Text
fragment =
  URI :: Maybe (RText 'Scheme)
-> Either Bool Authority
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
-> [QueryParam]
-> Maybe (RText 'Fragment)
-> URI
URI
    { uriScheme :: Maybe (RText 'Scheme)
uriScheme = Maybe (RText 'Scheme)
forall a. Maybe a
Nothing,
      uriAuthority :: Either Bool Authority
uriAuthority = Bool -> Either Bool Authority
forall a b. a -> Either a b
Left Bool
False,
      uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath = Maybe (Bool, NonEmpty (RText 'PathPiece))
forall a. Maybe a
Nothing,
      uriQuery :: [QueryParam]
uriQuery = [],
      uriFragment :: Maybe (RText 'Fragment)
uriFragment = Text -> Maybe (RText 'Fragment)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
URI.mkFragment Text
fragment
    }