module Converter.Internal where

import Data.Data (Data (toConstr), showConstr)
import Data.List (dropWhileEnd)
import Data.Text qualified as T

-- | A wrapper for prettyprinting strings
newtype Pretty a = Pretty String

instance Show a => Show (Pretty a) where
  show :: Pretty a -> String
  show :: Pretty a -> String
show (Pretty String
s) = String
s

-- | A class for prettyprinting data on multiple lines in haddocks.
--
-- It's not meant to be used outside of this library.
class Show a => PrettyPrint a where
  -- | A printing function
  --
  -- It's not meant to be used outside of this library.
  pp :: a -> Pretty String

instance PrettyPrint String where
  pp :: String -> Pretty String
  pp :: String -> Pretty String
pp = forall a. String -> Pretty a
Pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n')

instance PrettyPrint T.Text where
  pp :: T.Text -> Pretty String
  pp :: Text -> Pretty String
pp = forall a. PrettyPrint a => a -> Pretty String
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Escaped hash character
escapedHash :: T.Text
escapedHash :: Text
escapedHash = Text
"\\#"

-- | Hash character
hash :: T.Text
hash :: Text
hash = Text
"#"

-- | Drop a prefix of a line with length of a given line
dropLen :: T.Text -> T.Text -> T.Text
dropLen :: Text -> Text -> Text
dropLen Text
x Text
y = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
x) Text
y

-- | Check if a list starts with a given list
startsWith :: T.Text -> T.Text -> Bool
startsWith :: Text -> Text -> Bool
startsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isPrefixOf

-- | Check if a list ends with a given list
endsWith :: T.Text -> T.Text -> Bool
endsWith :: Text -> Text -> Bool
endsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isSuffixOf

-- | Drop leading spaces and drop at each end of a 'T.Text' the number of characters as in the supplied prefix and suffix.
stripEnds :: T.Text -> T.Text -> T.Text -> T.Text
stripEnds :: Text -> Text -> Text -> Text
stripEnds Text
prefix Text
suffix Text
x = Int -> Text -> Text
T.dropEnd (Text -> Int
T.length Text
suffix) (Text -> Text -> Text
dropLen Text
prefix (Text -> Text
stripSpaces Text
x))

-- | Drop spaces at the start and the end of a 'T.Text'.
stripSpaces :: T.Text -> T.Text
stripSpaces :: Text -> Text
stripSpaces = Text -> Text
T.strip

-- | Strip the given value from the beginning and the end of a list.
stripList :: Eq a => a -> [a] -> [a]
stripList :: forall a. Eq a => a -> [a] -> [a]
stripList a
x = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== a
x)

-- | Pad a 'T.Text' with a given number of spaces
indentN :: Int -> T.Text -> T.Text
indentN :: Int -> Text -> Text
indentN Int
x Text
s = [Text] -> Text
T.concat (forall a. Int -> a -> [a]
replicate Int
x Text
" ") forall a. Semigroup a => a -> a -> a
<> Text
s

-- | Show the name of a constructor.
constructorName :: Data a => a -> String
constructorName :: forall a. Data a => a -> String
constructorName a
x = Constr -> String
showConstr (forall a. Data a => a -> Constr
toConstr a
x)

-- | Remove empty lines from the beginning and the end of a list.
stripEmpties :: [T.Text] -> [T.Text]
stripEmpties :: [Text] -> [Text]
stripEmpties = forall a. Eq a => a -> [a] -> [a]
stripList Text
T.empty

-- | Drop leading empty strings
dropEmpties :: [T.Text] -> [T.Text]
dropEmpties :: [Text] -> [Text]
dropEmpties = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Text
T.empty)

-- | Check if a line without leading spaces is surrounded by the given 'T.Text's.
isEnclosedWith :: T.Text -> T.Text -> T.Text -> Bool
isEnclosedWith :: Text -> Text -> Text -> Bool
isEnclosedWith Text
start Text
end (Text -> Text
stripSpaces -> Text
x) = Text
x Text -> Text -> Bool
`startsWith` Text
start Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
`endsWith` Text
end

-- | Count leading spaces in a 'T.Text'.
countSpaces :: T.Text -> Int
countSpaces :: Text -> Int
countSpaces Text
x = Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
x

-- | Show error with line number for a token.
-- errorEmptyCommentAt :: Int -> String
errorEmptyCommentAt :: Show a1 => a1 -> a2
errorEmptyCommentAt :: forall a1 a2. Show a1 => a1 -> a2
errorEmptyCommentAt a1
lineNumber =
  forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
    (String
"Expected a 'Comment' at line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a1
lineNumber forall a. Semigroup a => a -> a -> a
<> String
".\n\n")
      forall a. Semigroup a => a -> a -> a
<> String
"However, there are no characters after '{- '.\n\n"
      forall a. Semigroup a => a -> a -> a
<> String
"Please, write there something after '{- '."


------
-- TeX

-- | Prepend start of a @TeX@ comment (@'% '@) to a 'T.Text'.
prependTexComment :: T.Text -> T.Text
prependTexComment :: Text -> Text
prependTexComment Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Text
l

-- | Drop start of a @TeX@ comment from a 'T.Text'.
dropTexComment :: Show a => T.Text -> a -> T.Text
dropTexComment :: forall a. Show a => Text -> a -> Text
dropTexComment Text
l a
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Text
texCommentSpace = Text -> Text -> Text
dropLen Text
texCommentSpace Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise =
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"Lines in a 'Disabled' block must either be empty or start with '% '\n\n"
          forall a. Semigroup a => a -> a -> a
<> String
"Note that each 'Disabled' block must have at least one line starting with '% ' and having nonempty text after '% ' "
          forall a. Semigroup a => a -> a -> a
<> (String
"The line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
lineNumber forall a. Semigroup a => a -> a -> a
<> String
" must either be empty or start with '% '")

-- | Start a @TeX@ comment.
texComment :: T.Text
texComment :: Text
texComment = Text
"%"

-- | Start a @TeX@ comment plus a space.
texCommentSpace :: T.Text
texCommentSpace :: Text
texCommentSpace = Text
texComment forall a. Semigroup a => a -> a -> a
<> Text
" "

-------------------
-- Literate Haskell

-- | Start a @Literate Haskell@ comment.
lhsComment :: T.Text
lhsComment :: Text
lhsComment = Text
"%"

-- | Start a @Literate Haskell@ comment plus a space.
lhsCommentSpace :: T.Text
lhsCommentSpace :: Text
lhsCommentSpace = Text
lhsComment forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Start a @Literate Haskell@ line of @Haskell@ code.
lhsHsCode :: T.Text
lhsHsCode :: Text
lhsHsCode = Text
">"

-- | Start a @Literate Haskell@ line of @Haskell@ code plus a space.
lhsHsCodeSpace :: T.Text
lhsHsCodeSpace :: Text
lhsHsCodeSpace = Text
lhsHsCode forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Prepend start of a @TeX@ comment (@'% '@) to a 'T.Text'.
prependLhsComment :: T.Text -> T.Text
prependLhsComment :: Text -> Text
prependLhsComment Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = Text
texCommentSpace forall a. Semigroup a => a -> a -> a
<> Text
l

-- | Drop start of a @TeX@ comment from a 'T.Text'.
dropLhsComment :: Show a => T.Text -> a -> T.Text
dropLhsComment :: forall a. Show a => Text -> a -> Text
dropLhsComment Text
l a
lineNumber
  | Text
l Text -> Text -> Bool
`startsWith` Text
lhsCommentSpace = Text -> Text -> Text
dropLen Text
lhsCommentSpace Text
l
  | Text
l forall a. Eq a => a -> a -> Bool
== Text
T.empty = Text
l
  | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"The line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
lineNumber forall a. Semigroup a => a -> a -> a
<> String
" must either be empty or start with '% '"

-- | Replace "\\#" with "#" in a 'T.Text' prefix.
lhsUnescapeHash :: T.Text -> T.Text
lhsUnescapeHash :: Text -> Text
lhsUnescapeHash Text
x = if Text
x Text -> Text -> Bool
`startsWith` Text
escapedHash then Text
hash forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text
dropLen Text
escapedHash Text
x) else Text
x

-- | Replace "#" with "\\#" in a 'T.Text' prefix.
lhsEscapeHash :: T.Text -> T.Text
lhsEscapeHash :: Text -> Text
lhsEscapeHash Text
x = if Text
x Text -> Text -> Bool
`startsWith` Text
hash then Text
escapedHash forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text
dropLen Text
hash Text
x) else Text
x

-----------
-- Markdown

-- | Open a @Markdown@ comment.
mdCommentOpen :: T.Text
mdCommentOpen :: Text
mdCommentOpen = Text
"<!--"

-- | Close a @Markdown@ comment.
mdCommentClose :: T.Text
mdCommentClose :: Text
mdCommentClose = Text
"-->"

-- | Open a @Markdown@ comment plus a space.
mdCommentOpenSpace :: T.Text
mdCommentOpenSpace :: Text
mdCommentOpenSpace = Text
mdCommentOpen forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | A space plus close a @Markdown@ comment.
mdCommentCloseSpace :: T.Text
mdCommentCloseSpace :: Text
mdCommentCloseSpace = Text
" " forall a. Semigroup a => a -> a -> a
<> Text
mdCommentClose

-- | Strip comment markers from a 'T.Text'.
stripMdComment :: T.Text -> T.Text
stripMdComment :: Text -> Text
stripMdComment = Text -> Text -> Text -> Text
stripEnds Text
mdCommentOpenSpace Text
mdCommentCloseSpace

-- | Check if a line is a @Markdown@ comment.
isMdComment :: T.Text -> Bool
isMdComment :: Text -> Bool
isMdComment = Text -> Text -> Text -> Bool
isEnclosedWith Text
mdCommentOpenSpace Text
mdCommentCloseSpace

-----------
-- Haskell

-- | Open a @Haskell@ multi-line comment.
hsCommentOpen :: T.Text
hsCommentOpen :: Text
hsCommentOpen = Text
"{-"

-- | Open a @Haskell@ multi-line comment plus a space.
hsCommentOpenSpace :: T.Text
hsCommentOpenSpace :: Text
hsCommentOpenSpace = Text
hsCommentOpen forall a. Semigroup a => a -> a -> a
<> Text
" "

-- | Close a @Haskell@ multi-line comment.
hsCommentClose :: T.Text
hsCommentClose :: Text
hsCommentClose = Text
"-}"

-- | A space plus close a @Haskell@ multi-line comment.
hsCommentCloseSpace :: T.Text
hsCommentCloseSpace :: Text
hsCommentCloseSpace = Text
" " forall a. Semigroup a => a -> a -> a
<> Text
hsCommentClose

-- | Drop leading spaces and drop at each end of a 'T.Text' the number of characters as in the supplied prefix and suffix.
stripHsComment :: T.Text -> T.Text
stripHsComment :: Text -> Text
stripHsComment = Text -> Text -> Text -> Text
stripEnds Text
hsCommentOpenSpace Text
hsCommentCloseSpace

-- | Check if a line without leading zeros is a multi-line @Haskell@ comment
isHsComment :: T.Text -> Bool
isHsComment :: Text -> Bool
isHsComment = Text -> Text -> Text -> Bool
isEnclosedWith Text
hsCommentOpenSpace Text
hsCommentCloseSpace