{-# 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 "\n"

-- Convert tabs to spaces using a 4-space tab stop.
tabFilter :: Text -> Text
tabFilter :: Text -> Text
tabFilter = [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
pad ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t')
  where pad :: [Text] -> [Text]
pad []  = []
        pad [t :: Text
t] = [Text
t]
        pad (t :: Text
t:ts :: [Text]
ts) = let tl :: Int
tl = Text -> Int
T.length Text
t
                         n :: Int
n  = Int
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
tl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4)
                         in  Int -> Char -> Text -> Text
T.justifyLeft Int
n ' ' Text
t Text -> [Text] -> [Text]
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 ' '  = Bool
True
isWhitespace '\t' = Bool
True
isWhitespace '\n' = Bool
True
isWhitespace '\r' = Bool
True
isWhitespace _    = 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 c :: 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 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
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 = () () -> Parser [()] -> Scanner
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Scanner -> Parser [()]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count 4 ((Char -> Bool) -> Scanner
skip (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==' '))

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

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

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

-- Scan a blankline.
scanBlankline :: Scanner
scanBlankline :: Scanner
scanBlankline = Scanner
scanSpaces Scanner -> Scanner -> Scanner
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==' ')

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

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

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