{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Cheapskate.Util (
    joinLines
  , tabFilter
  , isWhitespace
  , isEscapable
  , normalizeReference
  , Scanner
  , scanIndentSpace
  , scanNonindentSpace
  , scanSpacesToColumn
  , scanChar
  , scanBlankline
  , scanSpaces
  , scanSpnl
  , nfb
  , nfbChar
  , upToCountChars
  ) where

import Data.Text (Text)
import qualified Data.Text as T
import Data.Char
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Cheapskate.ParserCombinators

-- Utility functions.

-- Like T.unlines but does not add a final newline.
-- Concatenates lines with newlines between.
joinLines :: [Text] -> Text
joinLines :: [Text] -> Text
joinLines = Text -> [Text] -> Text
T.intercalate Text
"\n"

-- Convert tabs to spaces using a 4-space tab stop.
tabFilter :: Text -> Text
tabFilter :: Text -> Text
tabFilter = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
pad forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'\t')
  where pad :: [Text] -> [Text]
pad []  = []
        pad [Text
t] = [Text
t]
        pad (Text
t:[Text]
ts) = let tl :: Int
tl = Text -> Int
T.length Text
t
                         n :: Int
n  = Int
tl forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
- (Int
tl forall a. Integral a => a -> a -> a
`mod` Int
4)
                         in  Int -> Char -> Text -> Text
T.justifyLeft Int
n Char
' ' Text
t forall a. a -> [a] -> [a]
: [Text] -> [Text]
pad [Text]
ts

-- These are the whitespace characters that are significant in
-- parsing markdown. We can treat \160 (nonbreaking space) etc.
-- as regular characters.  This function should be considerably
-- faster than the unicode-aware isSpace from Data.Char.
isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
' '  = Bool
True
isWhitespace Char
'\t' = Bool
True
isWhitespace Char
'\n' = Bool
True
isWhitespace Char
'\r' = Bool
True
isWhitespace Char
_    = Bool
False

-- The original Markdown only allowed certain symbols
-- to be backslash-escaped.  It was hard to remember
-- which ones could be, so we now allow any ascii punctuation mark or
-- symbol to be escaped, whether or not it has a use in Markdown.
isEscapable :: Char -> Bool
isEscapable :: Char -> Bool
isEscapable Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c)

-- Link references are case sensitive and ignore line breaks
-- and repeated spaces.
-- So, [APPLES are good] == [Apples are good] ==
-- [Apples
-- are     good].
normalizeReference :: Text -> Text
normalizeReference :: Text -> Text
normalizeReference = Text -> Text
T.toCaseFold forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isWhitespace

-- Scanners are implemented here as attoparsec parsers,
-- which consume input and capture nothing.  They could easily
-- be implemented as regexes in other languages, or hand-coded.
-- With the exception of scanSpnl, they are all intended to
-- operate on a single line of input (so endOfInput = endOfLine).
type Scanner = Parser ()

-- Scan four spaces.
scanIndentSpace :: Scanner
scanIndentSpace :: Scanner
scanIndentSpace = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 ((Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
==Char
' '))

scanSpacesToColumn :: Int -> Scanner
scanSpacesToColumn :: Int -> Scanner
scanSpacesToColumn Int
col = do
  Int
currentCol <- Position -> Int
column forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Position
getPosition
  case Int
col forall a. Num a => a -> a -> a
- Int
currentCol of
       Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 -> () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n ((Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
==Char
' ')))
         | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Scan 0-3 spaces.
scanNonindentSpace :: Scanner
scanNonindentSpace :: Scanner
scanNonindentSpace = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> (Char -> Bool) -> Parser Text
upToCountChars Int
3 (forall a. Eq a => a -> a -> Bool
==Char
' ')

-- Scan a specified character.
scanChar :: Char -> Scanner
scanChar :: Char -> Scanner
scanChar Char
c = (Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
== Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Scan a blankline.
scanBlankline :: Scanner
scanBlankline :: Scanner
scanBlankline = Scanner
scanSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scanner
endOfInput

-- Scan 0 or more spaces
scanSpaces :: Scanner
scanSpaces :: Scanner
scanSpaces = (Char -> Bool) -> Scanner
skipWhile (forall a. Eq a => a -> a -> Bool
==Char
' ')

-- Scan 0 or more spaces, and optionally a newline
-- and more spaces.
scanSpnl :: Scanner
scanSpnl :: Scanner
scanSpnl = Scanner
scanSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Char -> Parser Char
char Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scanner
scanSpaces)

-- Not followed by: Succeed without consuming input if the specified
-- scanner would not succeed.
nfb :: Parser a -> Scanner
nfb :: forall a. Parser a -> Scanner
nfb = forall a. Parser a -> Scanner
notFollowedBy

-- Succeed if not followed by a character. Consumes no input.
nfbChar :: Char -> Scanner
nfbChar :: Char -> Scanner
nfbChar Char
c = forall a. Parser a -> Scanner
nfb ((Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
==Char
c))

upToCountChars :: Int -> (Char -> Bool) -> Parser Text
upToCountChars :: Int -> (Char -> Bool) -> Parser Text
upToCountChars Int
cnt Char -> Bool
f =
  forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan Int
0 (\Int
n Char
c -> if Int
n forall a. Ord a => a -> a -> Bool
< Int
cnt Bool -> Bool -> Bool
&& Char -> Bool
f Char
c then forall a. a -> Maybe a
Just (Int
nforall a. Num a => a -> a -> a
+Int
1) else forall a. Maybe a
Nothing)