{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# HLINT ignore "Redundant bracket" #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

-- | Functions to convert @Haskell@ to @Markdown@ and between @Literate Haskell@ (@.lhs@) and @Markdown@.
module Converter (hsToMd, mdToHs, lhsToMd, mdToLhs, Config (..), ConfigHsMd (..)) where

import Data.Default (Default)
import Data.Foldable (Foldable (..))
import Data.Function ((&))
import Data.List (isPrefixOf, isSuffixOf)
import Data.Yaml (FromJSON (..))
import Data.Yaml.Aeson (withObject, (.:), (.:?))
import GHC.Generics (Generic)

-- | App config.
newtype Config = Config {Config -> Maybe ConfigHsMd
configHsMd :: Maybe ConfigHsMd} deriving (forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic, Config
forall a. a -> Default a
def :: Config
$cdef :: Config
Default)

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Configs" (\Object
v -> Maybe ConfigHsMd -> Config
Config forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hs-md")

-- | Config for @Haskell@ to @Markdown@ converter.
newtype ConfigHsMd = ConfigHs2Md {ConfigHsMd -> [[Char]]
specialComments :: [String]} deriving (forall x. Rep ConfigHsMd x -> ConfigHsMd
forall x. ConfigHsMd -> Rep ConfigHsMd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigHsMd x -> ConfigHsMd
$cfrom :: forall x. ConfigHsMd -> Rep ConfigHsMd x
Generic, ConfigHsMd
forall a. a -> Default a
def :: ConfigHsMd
$cdef :: ConfigHsMd
Default)

instance FromJSON ConfigHsMd where
  parseJSON :: Value -> Parser ConfigHsMd
parseJSON =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject
      [Char]
"CommentsToIgnore"
      (\Object
v -> [[Char]] -> ConfigHsMd
ConfigHs2Md forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"special-comments")

backticks_ :: Int -> String
backticks_ :: Int -> [Char]
backticks_ Int
n = Int -> [Char] -> [Char]
indentN Int
n [Char]
backticks

backticks :: String
backticks :: [Char]
backticks = [Char]
"```"

haskellSnippet :: String
haskellSnippet :: [Char]
haskellSnippet = [Char]
backticks forall a. [a] -> [a] -> [a]
++ [Char]
"haskell"

consoleSnippet :: String
consoleSnippet :: [Char]
consoleSnippet = [Char]
backticks forall a. [a] -> [a] -> [a]
++ [Char]
"console"

chooseSnippetType :: String -> String
chooseSnippetType :: [Char] -> [Char]
chooseSnippetType [Char]
s
  | [Char]
s [Char] -> [Char] -> Bool
`startsWith` [Char]
birdTrack = [Char]
haskellSnippet
  | Bool
otherwise = [Char]
consoleSnippet

birdTrack :: String
birdTrack :: [Char]
birdTrack = [Char]
"> "

reverseBirdTrack :: String
reverseBirdTrack :: [Char]
reverseBirdTrack = [Char]
"< "

birdTracks :: [String]
birdTracks :: [[Char]]
birdTracks = [[Char]
birdTrack, [Char]
reverseBirdTrack]

-- | Convert @Literate Haskell@ to @Markdown@.
--
-- Convert @LHS@ birdtick style to @Markdown@, replacing the code marked by birdticks with @```haskell ... ```@.
lhsToMd :: String -> String
lhsToMd :: [Char] -> [Char]
lhsToMd = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
convert [Char]
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
 where
  convert :: String -> [String] -> [String]
  convert :: [Char] -> [[Char]] -> [[Char]]
convert [Char]
prev []
    | -- close code tags at the end
      [Char]
prev [Char] -> [[Char]] -> Bool
`startsWithAnyOf` [[Char]]
birdTracks =
        [[Char]
backticks]
    | Bool
otherwise = []
  convert [Char]
prev ([Char]
h : [[Char]]
t)
    | -- check for Haskell code to start
      -- insert newline above code block if needed
      Bool -> Bool
not ([Char]
prev [Char] -> [[Char]] -> Bool
`startsWithAnyOf` [[Char]]
birdTracks)
        Bool -> Bool -> Bool
&& ([Char]
h [Char] -> [[Char]] -> Bool
`startsWithAnyOf` [[Char]]
birdTracks) =
        ([[Char]
"" | [Char]
prev forall a. Eq a => a -> a -> Bool
/= [Char]
""]) forall a. [a] -> [a] -> [a]
++ [[Char] -> [Char]
chooseSnippetType [Char]
h, forall a. Int -> [a] -> [a]
drop Int
2 [Char]
h] forall a. [a] -> [a] -> [a]
++ [[Char]]
rest
    | -- check for code
      [Char]
h [Char] -> [[Char]] -> Bool
`startsWithAnyOf` [[Char]]
birdTracks =
        forall a. Int -> [a] -> [a]
drop Int
2 [Char]
h forall a. a -> [a] -> [a]
: [[Char]]
rest
    | -- check for code end, insert newline after code block if needed
      [Char]
prev [Char] -> [[Char]] -> Bool
`startsWithAnyOf` [[Char]]
birdTracks =
        [[Char]
backticks] forall a. [a] -> [a] -> [a]
++ ([[Char]
"" | [Char]
h forall a. Eq a => a -> a -> Bool
/= [Char]
""]) forall a. [a] -> [a] -> [a]
++ [[Char]
h] forall a. [a] -> [a] -> [a]
++ [[Char]]
rest
    | [Char]
h [Char] -> [Char] -> Bool
`startsWith` (Char
' ' forall a. a -> [a] -> [a]
: [Char]
birdTrack) =
        forall a. Int -> [a] -> [a]
drop Int
1 [Char]
h forall a. a -> [a] -> [a]
: [[Char]]
rest
    | Bool
otherwise = [Char] -> [[Char]]
shiftIfHeader [Char]
h forall a. [a] -> [a] -> [a]
++ [[Char]]
rest
   where
    rest :: [[Char]]
rest = [Char] -> [[Char]] -> [[Char]]
convert [Char]
h [[Char]]
t

-- | Convert @Markdown@ file to @Literate Haskell@.
--
-- Replace code marked with @```haskell ...```@ with birdticks (@>@)
-- and code marked with @``` ... ```@ with reverse birdticks (@<@).
mdToLhs :: String -> String
mdToLhs :: [Char] -> [Char]
mdToLhs = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False [Char]
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
 where
  convert :: Bool -> Bool -> String -> [String] -> [String]
  convert :: Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
inHsCode Bool
inSample [Char]
prev [] = []
  convert Bool
inHsCode Bool
inSample [Char]
prev ([Char]
h : [[Char]]
t)
    | -- handle code block starts, add newline if needed
      [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
haskellSnippet =
        ([[Char]
"" | [Char]
prev forall a. Eq a => a -> a -> Bool
/= [Char]
""]) forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False [Char]
prev [[Char]]
t
    | -- handle code
      Bool
inHsCode Bool -> Bool -> Bool
&& [Char]
h forall a. Eq a => a -> a -> Bool
/= [Char]
backticks =
        ([Char]
"> " forall a. [a] -> [a] -> [a]
++ [Char]
h) forall a. a -> [a] -> [a]
: Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False [Char]
h [[Char]]
t
    | -- handle code sample
      Bool
inSample Bool -> Bool -> Bool
&& [Char]
h forall a. Eq a => a -> a -> Bool
/= [Char]
backticks =
        ([Char]
"< " forall a. [a] -> [a] -> [a]
++ [Char]
h) forall a. a -> [a] -> [a]
: Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
False Bool
True [Char]
h [[Char]]
t
    | -- move headings one space to right
      [Char] -> Bool
isHeading [Char]
h =
        (Char
' ' forall a. a -> [a] -> [a]
: [Char]
h) forall a. a -> [a] -> [a]
: [[Char]]
rest
    | -- handle code and sample block ends
      (Bool
inHsCode Bool -> Bool -> Bool
|| Bool
inSample)
        Bool -> Bool -> Bool
&& [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
backticks =
        ([[Char]
"" | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
t Bool -> Bool -> Bool
|| forall a. [a] -> a
head [[Char]]
t forall a. Eq a => a -> a -> Bool
/= [Char]
""])
          forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False [Char]
prev [[Char]]
t
    | -- handle sample block starts, add newline if needed
      forall a. Int -> [a] -> [a]
take Int
3 [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
backticks =
        ([[Char]
"" | [Char]
prev forall a. Eq a => a -> a -> Bool
/= [Char]
""]) forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
False Bool
True [Char]
prev [[Char]]
t
    | -- handle quotes
      [Char]
h [Char] -> [Char] -> Bool
`startsWith` [Char]
birdTrack =
        ([Char]
" >" forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
1 [Char]
h) forall a. a -> [a] -> [a]
: [[Char]]
rest
    | Bool
otherwise = [Char]
h forall a. a -> [a] -> [a]
: [[Char]]
rest
   where
    -- count headings
    isHeading :: [Char] -> Bool
isHeading [Char]
h = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
== Char
'#') [Char]
h))
    rest :: [[Char]]
rest = Bool -> Bool -> [Char] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False [Char]
h [[Char]]
t

startsWith :: String -> String -> Bool
startsWith :: [Char] -> [Char] -> Bool
startsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf

startsWithAnyOf :: String -> [String] -> Bool
startsWithAnyOf :: [Char] -> [[Char]] -> Bool
startsWithAnyOf [Char]
l = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
startsWith [Char]
l)

shiftIfHeader :: String -> [String]
shiftIfHeader :: [Char] -> [[Char]]
shiftIfHeader [Char]
"" = [[Char]
""]
shiftIfHeader (Char
' ' : Char
'#' : [Char]
x) = [Char
'#' forall a. a -> [a] -> [a]
: [Char]
x]
shiftIfHeader [Char]
x = [[Char]
x]

_LIMA_DISABLE :: String
_LIMA_DISABLE :: [Char]
_LIMA_DISABLE = [Char]
"LIMA_DISABLE"

_LIMA_ENABLE :: String
_LIMA_ENABLE :: [Char]
_LIMA_ENABLE = [Char]
"LIMA_ENABLE"

_LIMA_INDENT :: String
_LIMA_INDENT :: [Char]
_LIMA_INDENT = [Char]
"LIMA_INDENT"

_LIMA_DEDENT :: String
_LIMA_DEDENT :: [Char]
_LIMA_DEDENT = [Char]
"LIMA_DEDENT"

-- | Comments that should be ignored for some reason
--
-- FOURMOLU_DISABLE is ignored because it's a special comment and shouldn't be visible in a `.md`
specialCommentsDefault :: [String]
specialCommentsDefault :: [[Char]]
specialCommentsDefault = [[Char]
"FOURMOLU_DISABLE", [Char]
"FOURMOLU_ENABLE", [Char]
_LIMA_INDENT, [Char]
_LIMA_DEDENT]

endsWith :: String -> String -> Bool
endsWith :: [Char] -> [Char] -> Bool
endsWith = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf

-- multi-line comments
mcOpen :: String
mcOpen :: [Char]
mcOpen = [Char]
"{-"

mcOpenSpace :: String
mcOpenSpace :: [Char]
mcOpenSpace = [Char]
mcOpen forall a. [a] -> [a] -> [a]
++ [Char]
" "

-- | multiline comment closing symbols
mcClose :: String
mcClose :: [Char]
mcClose = [Char]
"-}"

mcCloseSpace :: String
mcCloseSpace :: [Char]
mcCloseSpace = [Char]
" -}"

dropEnd :: Int -> String -> String
dropEnd :: Int -> [Char] -> [Char]
dropEnd Int
n [Char]
s = forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
drop Int
n (forall a. [a] -> [a]
reverse [Char]
s))

backticksHs :: String
backticksHs :: [Char]
backticksHs = [Char]
backticks forall a. [a] -> [a] -> [a]
++ [Char]
"haskell"

backticksHs_ :: Int -> String
backticksHs_ :: Int -> [Char]
backticksHs_ Int
n = Int -> [Char] -> [Char]
indentN Int
n [Char]
backticksHs

dropEmpties :: [String] -> [String]
dropEmpties :: [[Char]] -> [[Char]]
dropEmpties = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\[Char]
x -> [Char] -> [Char]
dropSpaces [Char]
x forall a. Eq a => a -> a -> Bool
== [Char]
"")

-- Markdown comments

-- | Open a @Markdown@ comment
mdcOpen :: String
mdcOpen :: [Char]
mdcOpen = [Char]
"<!--"

-- | Close a @Markdown@ comment
mdcClose :: String
mdcClose :: [Char]
mdcClose = [Char]
"-->"

mdcOpenSpace :: String
mdcOpenSpace :: [Char]
mdcOpenSpace = [Char]
mdcOpen forall a. [a] -> [a] -> [a]
++ [Char]
" "

mdcCloseSpace :: String
mdcCloseSpace :: [Char]
mdcCloseSpace = [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
mdcClose

-- | Remove multiline comment marks from the beginning and end of a string
stripMC :: String -> String
stripMC :: [Char] -> [Char]
stripMC [Char]
x = Int -> [Char] -> [Char]
dropEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
mcCloseSpace) (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
mcOpenSpace) [Char]
x)

indentN :: Int -> String -> String
indentN :: Int -> [Char] -> [Char]
indentN Int
x [Char]
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate Int
x [Char]
" ") forall a. [a] -> [a] -> [a]
++ [Char]
s

-- | Convert @Haskell@ to @Markdown@.
--
-- Multi-line comments are copied as text blocks and @Haskell@ code is copied as @Haskell@ snippets.
hsToMd :: ConfigHsMd -> String -> String
hsToMd :: ConfigHsMd -> [Char] -> [Char]
hsToMd ConfigHs2Md{[[Char]]
specialComments :: [[Char]]
specialComments :: ConfigHsMd -> [[Char]]
..} = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== [Char]
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[[Char]]
x -> Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False Bool
False Int
0 [[Char]]
x []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
 where
  specialComments_ :: [[Char]]
specialComments_ = [[Char]]
specialCommentsDefault forall a. [a] -> [a] -> [a]
++ [[Char]]
specialComments
  convert :: Bool -> Bool -> Bool -> Int -> [String] -> [String] -> [String]
  convert :: Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
inComments Bool
inSnippet Int
indent_ ([Char]
h : [[Char]]
hs) [[Char]]
res
    | Bool -> Bool
not Bool
inComments =
        if
            | -- disable
              -- split a snippet
              [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_DISABLE forall a. [a] -> [a] -> [a]
++ [Char]
mcCloseSpace ->
                (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
False Int
indent_ [[Char]]
hs)
                  ([[Char]
mdcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_DISABLE] forall a. [a] -> [a] -> [a]
++ [Int -> [Char]
backticks_ Int
indent_ | Bool
inSnippet] forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
dropEmpties [[Char]]
res)
            | -- enable
              [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_ENABLE forall a. [a] -> [a] -> [a]
++ [Char]
mcCloseSpace ->
                Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False Bool
inSnippet Int
indent_ [[Char]]
hs (([Char]
_LIMA_ENABLE forall a. [a] -> [a] -> [a]
++ [Char]
mdcCloseSpace) forall a. a -> [a] -> [a]
: [[Char]]
res)
            | -- disabled
              Bool -> Bool
not Bool
inLimaEnable ->
                Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
indent_ [[Char]]
hs ([Char]
h forall a. a -> [a] -> [a]
: [[Char]]
res)
            | -- indentation comment
              -- splits a snippet
              [Char]
h [Char] -> [[Char]] -> Bool
`startsWithAnyOf` (([Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]
_LIMA_INDENT, [Char]
_LIMA_DEDENT]) ->
                let h_ :: [Char]
h_ = [Char] -> [Char]
stripMC [Char]
h
                    isIndent :: Bool
isIndent = [Char]
h_ [Char] -> [Char] -> Bool
`startsWith` [Char]
_LIMA_INDENT
                    newIndent_ :: Int
newIndent_ = if Bool
isIndent then Int
indent_ forall a. Num a => a -> a -> a
+ (forall a. Read a => [Char] -> a
read @Int forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
_LIMA_INDENT) [Char]
h_) else Int
0
                    curIndent_ :: Int
curIndent_ = if Bool
isIndent then Int
newIndent_ else Int
indent_
                 in (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
newIndent_ [[Char]]
hs)
                      ( [Int -> [Char] -> [Char]
indentN Int
curIndent_ forall a b. (a -> b) -> a -> b
$ [Char]
mdcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
stripMC [Char]
h forall a. [a] -> [a] -> [a]
++ [Char]
mdcCloseSpace]
                          forall a. [a] -> [a] -> [a]
++ [[Char]
"" | Bool
inSnippet]
                          forall a. [a] -> [a] -> [a]
++ [Int -> [Char]
backticks_ Int
indent_ | Bool
inSnippet]
                          forall a. [a] -> [a] -> [a]
++ (if Bool
isIndent then [[Char]] -> [[Char]]
squashEmpties else [[Char]] -> [[Char]]
dropEmpties) [[Char]]
res
                      )
            | -- a special comment
              -- a comment should be in multi-line style like '{- FOURMOLU_DISABLE -}'
              -- it should occupy a single line
              -- it may be followed by arbitrary text in that line
              -- splits a snippet
              [Char]
h [Char] -> [[Char]] -> Bool
`startsWithAnyOf` (([Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
specialComments_) ->
                (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
indent_ [[Char]]
hs)
                  ([[Char]
mdcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
stripMC [Char]
h forall a. [a] -> [a] -> [a]
++ [Char]
mdcCloseSpace] forall a. [a] -> [a] -> [a]
++ [[Char]
"" | Bool
inSnippet] forall a. [a] -> [a] -> [a]
++ [Int -> [Char]
backticks_ Int
indent_ | Bool
inSnippet] forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
dropEmpties [[Char]]
res)
            | -- start of a multi-line comment
              -- it should be either like '{- ...' or '{-\n'
              ([Char]
h [Char] -> [Char] -> Bool
`startsWith` [Char]
mcOpenSpace Bool -> Bool -> Bool
|| [Char]
h forall a. Eq a => a -> a -> Bool
== [Char]
mcOpen) ->
                let x' :: [Char]
x' = forall a. Int -> [a] -> [a]
drop Int
3 [Char]
h
                    pref :: [[Char]]
pref = [Char]
"" forall a. a -> [a] -> [a]
: [Int -> [Char]
backticks_ Int
indent_ | Bool
inSnippet]
                    res' :: [[Char]]
res' = if Bool
inSnippet then [[Char]] -> [[Char]]
dropEmpties [[Char]]
res else [[Char]]
res
                 in -- if a multiline comment ends on the same line
                    -- it should end with '-}'
                    if [Char]
h [Char] -> [Char] -> Bool
`endsWith` [Char]
mcClose
                      then Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
indent_ [[Char]]
hs ([Int -> [Char] -> [Char]
dropEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
mcCloseSpace) [Char]
x'] forall a. [a] -> [a] -> [a]
++ [[Char]]
pref forall a. [a] -> [a] -> [a]
++ [[Char]]
res')
                      else Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
True Bool
False Int
indent_ [[Char]]
hs ([[Char]
x' | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x')] forall a. [a] -> [a] -> [a]
++ [[Char]]
pref forall a. [a] -> [a] -> [a]
++ [[Char]]
res')
            | -- non-empty line means the start of a Haskell snippet
              Bool -> Bool
not Bool
inSnippet ->
                if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
h)
                  then -- non-empty line means the start of a Haskell snippet
                    Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
True Int
indent_ [[Char]]
hs ([Int -> [Char] -> [Char]
indentN Int
indent_ [Char]
h, Int -> [Char]
backticksHs_ Int
indent_] forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
squashEmpties [[Char]]
res)
                  else -- if not in snippet, collapse consequent empty lines
                    Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
indent_ [[Char]]
hs [[Char]]
res
            | Bool
inSnippet ->
                Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
True Int
indent_ [[Char]]
hs ((Int -> [Char] -> [Char]
indentN Int
indent_ [Char]
h) forall a. a -> [a] -> [a]
: [[Char]]
res)
    | Bool
inComments =
        if [Char]
h [Char] -> [Char] -> Bool
`startsWith` [Char]
mcClose
          then -- end of a multiline comment
            Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
False Bool
False Int
indent_ [[Char]]
hs ([[Char]]
res)
          else -- copy everything from comments
            Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inLimaEnable Bool
True Bool
False Int
indent_ [[Char]]
hs ([Char]
h forall a. a -> [a] -> [a]
: [[Char]]
res)
  convert Bool
_ Bool
_ Bool
inSnippet Int
indent_ [] [[Char]]
res =
    [Int -> [Char]
backticks_ Int
indent_ | Bool
inSnippet] forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
dropEmpties [[Char]]
res

stripMdc :: String -> String
stripMdc :: [Char] -> [Char]
stripMdc [Char]
x = Int -> [Char] -> [Char]
dropEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
mdcCloseSpace) (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
mdcOpenSpace) ([Char] -> [Char]
dropSpaces [Char]
x))

squashEmpties :: [String] -> [String]
squashEmpties :: [[Char]] -> [[Char]]
squashEmpties = ([[Char]
""] forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
dropEmpties

dropSpaces :: String -> String
dropSpaces :: [Char] -> [Char]
dropSpaces = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ')

countSpaces :: String -> Int
countSpaces :: [Char] -> Int
countSpaces [Char]
x = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') [Char]
x

-- | Convert @Markdown@ to @Haskell@.
--
-- Multi-line comments are copied as text blocks and @Haskell@ code is copied as @Haskell@ snippets.
mdToHs :: ConfigHsMd -> String -> String
mdToHs :: ConfigHsMd -> [Char] -> [Char]
mdToHs ConfigHs2Md{[[Char]]
specialComments :: [[Char]]
specialComments :: ConfigHsMd -> [[Char]]
..} = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== [Char]
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[[Char]]
x -> Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
False Int
0 [[Char]]
x []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
 where
  specialComments_ :: [[Char]]
specialComments_ = [[Char]]
specialCommentsDefault forall a. [a] -> [a] -> [a]
++ [[Char]]
specialComments
  closeTextIf :: Bool -> [[Char]]
closeTextIf Bool
x = [[Char]
mcClose | Bool
x]
  convert :: Bool -> Bool -> Bool -> Int -> [String] -> [String] -> [String]
  convert :: Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inText Bool
inSnippet Bool
inComments Int
dedent_ ([Char]
h : [[Char]]
hs) [[Char]]
res
    | Bool
inComments =
        -- enable
        if [Char]
h [Char] -> [Char] -> Bool
`startsWith` ([Char]
_LIMA_ENABLE forall a. [a] -> [a] -> [a]
++ [Char]
mdcCloseSpace)
          then -- split text

            (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inText Bool
inSnippet Bool
False Int
dedent_ [[Char]]
hs)
              ([[Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_ENABLE forall a. [a] -> [a] -> [a]
++ [Char]
mcCloseSpace] forall a. [a] -> [a] -> [a]
++ [[Char]
"" | Bool
inText] forall a. [a] -> [a] -> [a]
++ Bool -> [[Char]]
closeTextIf Bool
inText forall a. [a] -> [a] -> [a]
++ [[Char]]
res)
          else -- copy lines
            Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
True Int
dedent_ [[Char]]
hs ([Char]
h forall a. a -> [a] -> [a]
: [[Char]]
res)
    | Bool -> Bool
not Bool
inSnippet =
        if
            | -- found a disable comment
              [Char]
h [Char] -> [Char] -> Bool
`startsWith` ([Char]
mdcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_DISABLE) ->
                (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
True Int
dedent_ [[Char]]
hs)
                  ([[Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char]
_LIMA_DISABLE forall a. [a] -> [a] -> [a]
++ [Char]
mcCloseSpace, [Char]
""] forall a. [a] -> [a] -> [a]
++ Bool -> [[Char]]
closeTextIf Bool
inText forall a. [a] -> [a] -> [a]
++ [[Char]]
res)
            | -- found a special comment
              ([Char] -> [Char]
dropSpaces [Char]
h) [Char] -> [[Char]] -> Bool
`startsWithAnyOf` (([Char]
mdcOpenSpace forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
specialComments_) ->
                (Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
False Int
dedent_ [[Char]]
hs)
                  ([[Char]
mcOpenSpace forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
stripMdc [Char]
h forall a. [a] -> [a] -> [a]
++ [Char]
mcCloseSpace] forall a. [a] -> [a] -> [a]
++ [[Char]
""] forall a. [a] -> [a] -> [a]
++ Bool -> [[Char]]
closeTextIf Bool
inText forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
dropEmpties [[Char]]
res)
            | -- start of a haskell snippet
              ([Char] -> [Char]
dropSpaces [Char]
h) [Char] -> [Char] -> Bool
`startsWith` [Char]
backticksHs ->
                Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
True Bool
False ([Char] -> Int
countSpaces [Char]
h) [[Char]]
hs ([[Char]
""] forall a. [a] -> [a] -> [a]
++ Bool -> [[Char]]
closeTextIf Bool
inText forall a. [a] -> [a] -> [a]
++ [[Char]] -> [[Char]]
dropEmpties [[Char]]
res)
            | Bool -> Bool
not Bool
inText ->
                if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
h
                  then -- just a blank line
                    Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
inText Bool
False Bool
False Int
dedent_ [[Char]]
hs [[Char]]
res
                  else -- start of text
                    Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False Bool
False Int
dedent_ [[Char]]
hs ([[Char]
h, [Char]
mcOpen, [Char]
""] forall a. [a] -> [a] -> [a]
++ [[Char]]
res)
            | -- copy text line by line
              Bool
otherwise ->
                Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
True Bool
False Bool
False Int
dedent_ [[Char]]
hs ([Char]
h forall a. a -> [a] -> [a]
: [[Char]]
res)
    | Bool
otherwise =
        if ([Char] -> [Char]
dropSpaces [Char]
h) forall a. Eq a => a -> a -> Bool
== [Char]
backticks
          then -- end of a snippet
            Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
False Bool
False Int
0 [[Char]]
hs [[Char]]
res
          else -- in a snippet
            Bool -> Bool -> Bool -> Int -> [[Char]] -> [[Char]] -> [[Char]]
convert Bool
False Bool
True Bool
False Int
dedent_ [[Char]]
hs ((forall a. Int -> [a] -> [a]
drop Int
dedent_ [Char]
h) forall a. a -> [a] -> [a]
: [[Char]]
res)
  convert Bool
inText Bool
_ Bool
_ Int
dedent_ [] [[Char]]
res = [[Char]
mcClose | Bool
inText] forall a. [a] -> [a] -> [a]
++ [[Char]]
res