{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Markdown.Unlit (
  run
, unlit
, Selector (..)
, parseSelector
, CodeBlock (..)
, parse
#ifdef TEST
, parseReorderingKey
, parseClasses
#endif
) where

import           Prelude ()
import           Prelude.Compat
import           Control.Arrow
import           Data.Char
import           Data.List.Compat
import           Data.Maybe
import           Data.String
import           System.Environment
import           System.Exit
import           System.IO
import           Text.Read

fenceChars :: [Char]
fenceChars :: String
fenceChars = [Char
'`', Char
'~']

fences :: [String]
fences :: [String]
fences = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
3) String
fenceChars

-- | Program entry point.
run :: [String] -> IO ()
run :: [String] -> IO ()
run [String]
args =
  -- GHC calls unlit like so:
  --
  -- > unlit [args] -h label Foo.lhs /tmp/somefile
  --
  -- [args] are custom arguments provided with -optL
  --
  -- The label is meant to be used in line pragmas, like so:
  --
  -- #line 1 "label"
  --
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== String
"-h") [String]
args of
    ([String] -> Selector
mkSelector -> Selector
selector, String
"-h" : [String]
files) -> case [String]
files of
      [String
src, String
cur, String
dst] -> do
        String -> IO String
readFileUtf8 String
cur forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> IO ()
writeFileUtf8 String
dst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Selector -> String -> String
unlit String
src Selector
selector
      [String
src] -> do
        String -> IO String
readFileUtf8 String
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> String -> IO ()
writeUtf8 Handle
stdout forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Selector -> String -> String
unlit String
src Selector
selector
      [String]
_ -> IO ()
usage
    ([String], [String])
_ -> IO ()
usage
    where
      usage :: IO ()
      usage :: IO ()
usage = do
        String
name <- IO String
getProgName
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"usage: " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" [selector] -h SRC CUR DST")
        forall a. IO a
exitFailure

      mkSelector :: [String] -> Selector
      mkSelector :: [String] -> Selector
mkSelector = forall a. a -> Maybe a -> a
fromMaybe (Selector
"haskell" Selector -> Selector -> Selector
:&: Selector -> Selector
Not Selector
"ignore") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Selector
parseSelector forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

      readFileUtf8 :: FilePath -> IO String
      readFileUtf8 :: String -> IO String
readFileUtf8 String
name = String -> IOMode -> IO Handle
openFile String
name IOMode
ReadMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Handle
handle -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO String
hGetContents Handle
handle

      writeFileUtf8 :: FilePath -> String -> IO ()
      writeFileUtf8 :: String -> String -> IO ()
writeFileUtf8 String
name String
str = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \ Handle
handle -> Handle -> String -> IO ()
writeUtf8 Handle
handle String
str

      writeUtf8 :: Handle -> String -> IO ()
      writeUtf8 :: Handle -> String -> IO ()
writeUtf8 Handle
handle String
str = Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
handle String
str

unlit :: FilePath -> Selector -> String -> String
unlit :: String -> Selector -> String -> String
unlit String
src Selector
selector = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CodeBlock -> [String]
formatCodeBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CodeBlock] -> [CodeBlock]
sortCodeBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Selector -> [String] -> Bool
toPredicate Selector
selector forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBlock -> [String]
codeBlockClasses) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [CodeBlock]
parse
  where
    formatCodeBlock :: CodeBlock -> [String]
    formatCodeBlock :: CodeBlock -> [String]
formatCodeBlock CodeBlock
cb = (String
"#line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CodeBlock -> Int
codeBlockStartLine CodeBlock
cb) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
src) forall a. a -> [a] -> [a]
: CodeBlock -> [String]
codeBlockContent CodeBlock
cb

    sortCodeBlocks :: [CodeBlock] -> [CodeBlock]
    sortCodeBlocks :: [CodeBlock] -> [CodeBlock]
sortCodeBlocks = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
addSortKey
      where
        addSortKey :: [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
        addSortKey :: [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
addSortKey = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> CodeBlock -> (ReorderingKey, a)
sortKey) [DeclarationOrder
0..]

        sortKey :: a -> CodeBlock -> (ReorderingKey, a)
        sortKey :: forall a. a -> CodeBlock -> (ReorderingKey, a)
sortKey a
n CodeBlock
code = (CodeBlock -> ReorderingKey
reorderingKey CodeBlock
code, a
n)

    toPredicate :: Selector -> [String] -> Bool
    toPredicate :: Selector -> [String] -> Bool
toPredicate = forall {t :: * -> *}. Foldable t => Selector -> t String -> Bool
go
      where
        go :: Selector -> t String -> Bool
go Selector
s = case Selector
s of
          Class String
c -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
c
          Not Selector
p   -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> t String -> Bool
go Selector
p
          Selector
a :&: Selector
b -> Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> t String -> Bool
go Selector
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> t String -> Bool
go Selector
b
          Selector
a :|: Selector
b -> Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> t String -> Bool
go Selector
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> t String -> Bool
go Selector
b

newtype DeclarationOrder = DeclarationOrder Int
  deriving newtype (DeclarationOrder -> DeclarationOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclarationOrder -> DeclarationOrder -> Bool
$c/= :: DeclarationOrder -> DeclarationOrder -> Bool
== :: DeclarationOrder -> DeclarationOrder -> Bool
$c== :: DeclarationOrder -> DeclarationOrder -> Bool
Eq, Eq DeclarationOrder
DeclarationOrder -> DeclarationOrder -> Bool
DeclarationOrder -> DeclarationOrder -> Ordering
DeclarationOrder -> DeclarationOrder -> DeclarationOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$cmin :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
max :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$cmax :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
>= :: DeclarationOrder -> DeclarationOrder -> Bool
$c>= :: DeclarationOrder -> DeclarationOrder -> Bool
> :: DeclarationOrder -> DeclarationOrder -> Bool
$c> :: DeclarationOrder -> DeclarationOrder -> Bool
<= :: DeclarationOrder -> DeclarationOrder -> Bool
$c<= :: DeclarationOrder -> DeclarationOrder -> Bool
< :: DeclarationOrder -> DeclarationOrder -> Bool
$c< :: DeclarationOrder -> DeclarationOrder -> Bool
compare :: DeclarationOrder -> DeclarationOrder -> Ordering
$ccompare :: DeclarationOrder -> DeclarationOrder -> Ordering
Ord, Int -> DeclarationOrder
DeclarationOrder -> Int
DeclarationOrder -> [DeclarationOrder]
DeclarationOrder -> DeclarationOrder
DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
$cenumFromThenTo :: DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFromTo :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
$cenumFromTo :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFromThen :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
$cenumFromThen :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFrom :: DeclarationOrder -> [DeclarationOrder]
$cenumFrom :: DeclarationOrder -> [DeclarationOrder]
fromEnum :: DeclarationOrder -> Int
$cfromEnum :: DeclarationOrder -> Int
toEnum :: Int -> DeclarationOrder
$ctoEnum :: Int -> DeclarationOrder
pred :: DeclarationOrder -> DeclarationOrder
$cpred :: DeclarationOrder -> DeclarationOrder
succ :: DeclarationOrder -> DeclarationOrder
$csucc :: DeclarationOrder -> DeclarationOrder
Enum, Integer -> DeclarationOrder
DeclarationOrder -> DeclarationOrder
DeclarationOrder -> DeclarationOrder -> DeclarationOrder
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> DeclarationOrder
$cfromInteger :: Integer -> DeclarationOrder
signum :: DeclarationOrder -> DeclarationOrder
$csignum :: DeclarationOrder -> DeclarationOrder
abs :: DeclarationOrder -> DeclarationOrder
$cabs :: DeclarationOrder -> DeclarationOrder
negate :: DeclarationOrder -> DeclarationOrder
$cnegate :: DeclarationOrder -> DeclarationOrder
* :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$c* :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
- :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$c- :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
+ :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$c+ :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
Num)

newtype ReorderingKey = ReorderingKey Int
  deriving newtype (ReorderingKey -> ReorderingKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReorderingKey -> ReorderingKey -> Bool
$c/= :: ReorderingKey -> ReorderingKey -> Bool
== :: ReorderingKey -> ReorderingKey -> Bool
$c== :: ReorderingKey -> ReorderingKey -> Bool
Eq, Int -> ReorderingKey -> String -> String
[ReorderingKey] -> String -> String
ReorderingKey -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReorderingKey] -> String -> String
$cshowList :: [ReorderingKey] -> String -> String
show :: ReorderingKey -> String
$cshow :: ReorderingKey -> String
showsPrec :: Int -> ReorderingKey -> String -> String
$cshowsPrec :: Int -> ReorderingKey -> String -> String
Show, ReadPrec [ReorderingKey]
ReadPrec ReorderingKey
Int -> ReadS ReorderingKey
ReadS [ReorderingKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReorderingKey]
$creadListPrec :: ReadPrec [ReorderingKey]
readPrec :: ReadPrec ReorderingKey
$creadPrec :: ReadPrec ReorderingKey
readList :: ReadS [ReorderingKey]
$creadList :: ReadS [ReorderingKey]
readsPrec :: Int -> ReadS ReorderingKey
$creadsPrec :: Int -> ReadS ReorderingKey
Read, Eq ReorderingKey
ReorderingKey -> ReorderingKey -> Bool
ReorderingKey -> ReorderingKey -> Ordering
ReorderingKey -> ReorderingKey -> ReorderingKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReorderingKey -> ReorderingKey -> ReorderingKey
$cmin :: ReorderingKey -> ReorderingKey -> ReorderingKey
max :: ReorderingKey -> ReorderingKey -> ReorderingKey
$cmax :: ReorderingKey -> ReorderingKey -> ReorderingKey
>= :: ReorderingKey -> ReorderingKey -> Bool
$c>= :: ReorderingKey -> ReorderingKey -> Bool
> :: ReorderingKey -> ReorderingKey -> Bool
$c> :: ReorderingKey -> ReorderingKey -> Bool
<= :: ReorderingKey -> ReorderingKey -> Bool
$c<= :: ReorderingKey -> ReorderingKey -> Bool
< :: ReorderingKey -> ReorderingKey -> Bool
$c< :: ReorderingKey -> ReorderingKey -> Bool
compare :: ReorderingKey -> ReorderingKey -> Ordering
$ccompare :: ReorderingKey -> ReorderingKey -> Ordering
Ord, ReorderingKey
forall a. a -> a -> Bounded a
maxBound :: ReorderingKey
$cmaxBound :: ReorderingKey
minBound :: ReorderingKey
$cminBound :: ReorderingKey
Bounded, Integer -> ReorderingKey
ReorderingKey -> ReorderingKey
ReorderingKey -> ReorderingKey -> ReorderingKey
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ReorderingKey
$cfromInteger :: Integer -> ReorderingKey
signum :: ReorderingKey -> ReorderingKey
$csignum :: ReorderingKey -> ReorderingKey
abs :: ReorderingKey -> ReorderingKey
$cabs :: ReorderingKey -> ReorderingKey
negate :: ReorderingKey -> ReorderingKey
$cnegate :: ReorderingKey -> ReorderingKey
* :: ReorderingKey -> ReorderingKey -> ReorderingKey
$c* :: ReorderingKey -> ReorderingKey -> ReorderingKey
- :: ReorderingKey -> ReorderingKey -> ReorderingKey
$c- :: ReorderingKey -> ReorderingKey -> ReorderingKey
+ :: ReorderingKey -> ReorderingKey -> ReorderingKey
$c+ :: ReorderingKey -> ReorderingKey -> ReorderingKey
Num)

reorderingKey :: CodeBlock -> ReorderingKey
reorderingKey :: CodeBlock -> ReorderingKey
reorderingKey = [String] -> ReorderingKey
parseReorderingKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBlock -> [String]
codeBlockClasses

parseReorderingKey :: [String] -> ReorderingKey
parseReorderingKey :: [String] -> ReorderingKey
parseReorderingKey = [String] -> ReorderingKey
go
  where
    go :: [String] -> ReorderingKey
    go :: [String] -> ReorderingKey
go = \ case
      [] -> ReorderingKey
0
      String
"top" : [String]
_ -> forall a. Bounded a => a
minBound
      (Char
't' : Char
'o' : Char
'p' : Char
':' : (forall a. Read a => String -> Maybe a
readMaybe -> Just ReorderingKey
n)) : [String]
_ -> forall a. Bounded a => a
minBound forall a. Num a => a -> a -> a
+ ReorderingKey
n
      String
_ : [String]
classes -> [String] -> ReorderingKey
go [String]
classes

infixr 3 :&:
infixr 2 :|:

data Selector
  = Class String
  | Not Selector
  | Selector :&: Selector
  | Selector :|: Selector
  deriving (Selector -> Selector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, Int -> Selector -> String -> String
[Selector] -> String -> String
Selector -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Selector] -> String -> String
$cshowList :: [Selector] -> String -> String
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> String -> String
$cshowsPrec :: Int -> Selector -> String -> String
Show)

parseSelector :: String -> Maybe Selector
parseSelector :: String -> Maybe Selector
parseSelector String
input = case String -> [String]
words String
input of
  [] -> forall a. Maybe a
Nothing
  [String]
xs -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Selector -> Selector -> Selector
(:|:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Selector
parseAnds) [String]
xs
  where
    parseAnds :: String -> Selector
parseAnds = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Selector -> Selector -> Selector
(:&:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Selector
parseClass forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
split (forall a. Eq a => a -> a -> Bool
== Char
'+')

    parseClass :: String -> Selector
parseClass String
c = case String
c of
      Char
'!':String
xs -> Selector -> Selector
Not (String -> Selector
Class String
xs)
      String
_      -> String -> Selector
Class String
c

    -- a copy from https://github.com/sol/string
    split :: (Char -> Bool) -> String -> [String]
    split :: (Char -> Bool) -> String -> [String]
split Char -> Bool
p = String -> [String]
go
      where
        go :: String -> [String]
go String
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
xs of
          (String
ys, [])   -> [String
ys]
          (String
ys, Char
_:String
zs) -> String
ys forall a. a -> [a] -> [a]
: String -> [String]
go String
zs

instance IsString Selector where
  fromString :: String -> Selector
fromString = String -> Selector
Class

data CodeBlock = CodeBlock {
  CodeBlock -> [String]
codeBlockClasses   :: [String]
, CodeBlock -> [String]
codeBlockContent   :: [String]
, CodeBlock -> Int
codeBlockStartLine :: Int
} deriving (CodeBlock -> CodeBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeBlock -> CodeBlock -> Bool
$c/= :: CodeBlock -> CodeBlock -> Bool
== :: CodeBlock -> CodeBlock -> Bool
$c== :: CodeBlock -> CodeBlock -> Bool
Eq, Int -> CodeBlock -> String -> String
[CodeBlock] -> String -> String
CodeBlock -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CodeBlock] -> String -> String
$cshowList :: [CodeBlock] -> String -> String
show :: CodeBlock -> String
$cshow :: CodeBlock -> String
showsPrec :: Int -> CodeBlock -> String -> String
$cshowsPrec :: Int -> CodeBlock -> String -> String
Show)

type Line = (Int, String)

parse :: String -> [CodeBlock]
parse :: String -> [CodeBlock]
parse = [Line] -> [CodeBlock]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    go :: [Line] -> [CodeBlock]
    go :: [Line] -> [CodeBlock]
go [Line]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Line -> Bool
isFence [Line]
xs of
      ([Line]
_, [])   -> []
      ([Line]
_, Line
y:[Line]
ys) -> case Line -> [Line] -> (CodeBlock, [Line])
takeCB Line
y [Line]
ys of
        (CodeBlock
cb, [Line]
rest) -> CodeBlock
cb forall a. a -> [a] -> [a]
: [Line] -> [CodeBlock]
go [Line]
rest

    takeCB :: Line -> [Line] -> (CodeBlock, [Line])
    takeCB :: Line -> [Line] -> (CodeBlock, [Line])
takeCB (Int
n, String
fence) [Line]
xs =
      let indent :: Int
indent = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ String
fence
      in case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Line -> Bool
isFence [Line]
xs of
        ([Line]
cb, [Line]
rest) -> ([String] -> [String] -> Int -> CodeBlock
CodeBlock (String -> [String]
parseClasses String
fence) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [Line]
cb) Int
n, forall a. Int -> [a] -> [a]
drop Int
1 [Line]
rest)

    isFence :: Line -> Bool
    isFence :: Line -> Bool
isFence = String -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
      where
        p :: String -> Bool
        p :: String -> Bool
p String
line = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line) [String]
fences

parseClasses :: String -> [String]
parseClasses :: String -> [String]
parseClasses String
xs = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> String -> String
replace Char
'.' Char
' ' forall a b. (a -> b) -> a -> b
$ case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
fenceChars) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ String
xs of
  Char
'{':String
ys -> forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'}') String
ys
  String
ys -> String
ys

replace :: Char -> Char -> String -> String
replace :: Char -> Char -> String -> String
replace Char
x Char
sub = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
  where
    f :: Char -> Char
f Char
y | Char
x forall a. Eq a => a -> a -> Bool
== Char
y    = Char
sub
        | Bool
otherwise = Char
y