module Run (run, snipStartT, snipEndT) where

import Import
import Path.Posix
import Path.IO
import Data.Attoparsec.Text as Parser
import RIO.Text qualified as T
import RIO.List qualified as L

data LeadingWS = NoLeadingWS | LeadingSpaces Word | LeadingTabs Word deriving (Int -> LeadingWS -> ShowS
[LeadingWS] -> ShowS
LeadingWS -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeadingWS] -> ShowS
$cshowList :: [LeadingWS] -> ShowS
show :: LeadingWS -> String
$cshow :: LeadingWS -> String
showsPrec :: Int -> LeadingWS -> ShowS
$cshowsPrec :: Int -> LeadingWS -> ShowS
Show)

data ParsedLine = EmptyLine | StartMarkerLine (Maybe (Path Rel File)) | EndMarkerLine (Maybe (Path Rel File)) | ContentLine (LeadingWS,Text) deriving (Int -> ParsedLine -> ShowS
[ParsedLine] -> ShowS
ParsedLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedLine] -> ShowS
$cshowList :: [ParsedLine] -> ShowS
show :: ParsedLine -> String
$cshow :: ParsedLine -> String
showsPrec :: Int -> ParsedLine -> ShowS
$cshowsPrec :: Int -> ParsedLine -> ShowS
Show)

mkContentLine :: Text -> ParsedLine
mkContentLine :: Text -> ParsedLine
mkContentLine Text
content = (LeadingWS, Text) -> ParsedLine
ContentLine forall a b. (a -> b) -> a -> b
$ case Text -> Maybe (Char, Text)
T.uncons Text
content of
  Maybe (Char, Text)
Nothing -> (LeadingWS
NoLeadingWS, Text
"")
  Just (Char
'\t', Text
_) -> 
    let (Text
tabs,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char
'\t' forall a. Eq a => a -> a -> Bool
==) Text
content in
    (Word -> LeadingWS
LeadingTabs (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
tabs), Text -> Text
T.copy Text
rest)
  Just (Char
' ', Text
_) -> 
    let (Text
spaces,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char
' ' forall a. Eq a => a -> a -> Bool
==) Text
content in
    (Word -> LeadingWS
LeadingSpaces (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
spaces), Text -> Text
T.copy Text
rest)
  Just (Char, Text)
_ -> 
    (LeadingWS
NoLeadingWS, Text
content)

parseLine :: Text -> RIO App ParsedLine
parseLine :: Text -> RIO App ParsedLine
parseLine Text
content = 
    case Either String ParsedLine
result of 
      Left String
err -> do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
          String
"Defaulting back to content line: " forall a. Semigroup a => a -> a -> a
<> String
err
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ParsedLine
mkContentLine Text
content
      Right ParsedLine
val -> do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
          String
"Parsed non-content line: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParsedLine
val
        forall (m :: * -> *) a. Monad m => a -> m a
return ParsedLine
val
  where
    result :: Either String ParsedLine
result = (forall a. Parser a -> Text -> Either String a
`parseOnly` Text
content) forall a b. (a -> b) -> a -> b
$ 
      Parser ParsedLine
parseEmptyLine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedLine
parseEndMarker forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedLine
parseStartMarker

snipStartT :: Text
snipStartT :: Text
snipStartT = Text
"<<<@snip"

parseEmptyLine :: Parser ParsedLine
parseEmptyLine :: Parser ParsedLine
parseEmptyLine =
  Parser Text ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Chunk t => Parser t ()
endOfInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ParsedLine
EmptyLine

parseStartMarker :: Parser ParsedLine
parseStartMarker :: Parser ParsedLine
parseStartMarker = 
    Parser Text Text
parseStartMarkerBeginning forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
      (Maybe (Path Rel File) -> ParsedLine
StartMarkerLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (Maybe (Path Rel File))
parseLabel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing))
  where
    parseStartMarkerBeginning :: Parser Text Text
parseStartMarkerBeginning = 
      Text -> Parser Text Text
string Text
snipStartT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Int -> Parser Text Text
Parser.take Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
parseStartMarkerBeginning)

snipEndT :: Text
snipEndT :: Text
snipEndT = Text
"@snip>>>"

parseEndMarker :: Parser ParsedLine
parseEndMarker :: Parser ParsedLine
parseEndMarker = 
    Parser Text Text
parseEndMarkerBeginning forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (Maybe (Path Rel File) -> ParsedLine
EndMarkerLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (Maybe (Path Rel File))
parseLabel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing))
  where
    parseEndMarkerBeginning :: Parser Text Text
parseEndMarkerBeginning = 
      Text -> Parser Text Text
string Text
snipEndT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Int -> Parser Text Text
Parser.take Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
parseEndMarkerBeginning)

parseLabel :: Parser (Maybe (Path Rel File))
parseLabel :: Parser Text (Maybe (Path Rel File))
parseLabel = do
  Parser Text ()
skipSpace
  Text
lbl <- (Char -> Bool) -> Parser Text Text
Parser.takeTill Char -> Bool
Parser.isHorizontalSpace
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (Text -> String
T.unpack Text
lbl)

run :: RIO App ()
run :: RIO App ()
run = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \App{Set (Path Rel File)
appFiles :: App -> Set (Path Rel File)
appFiles :: Set (Path Rel File)
appFiles} ->
  forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
pooledMapConcurrently_ Path Rel File -> RIO App ()
runFile Set (Path Rel File)
appFiles

runFile :: Path Rel File -> RIO App ()
runFile :: Path Rel File -> RIO App ()
runFile Path Rel File
relFile = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \App{Path Abs Dir
appBaseDir :: App -> Path Abs Dir
appBaseDir :: Path Abs Dir
appBaseDir,Path Abs Dir
appOutputDir :: App -> Path Abs Dir
appOutputDir :: Path Abs Dir
appOutputDir} -> do
    let inFile :: Path Abs File
inFile = Path Abs Dir
appBaseDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFile
    let outDirBase :: Path Abs File
outDirBase = Path Abs Dir
appOutputDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFile
    Path Abs Dir
outDir <- forall (m :: * -> *) b.
MonadThrow m =>
String -> Path b File -> m (Path b File)
addExtension String
".snips" Path Abs File
outDirBase forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b.
MonadThrow m =>
String -> Path b File -> m (Path b File)
addExtension String
".d" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {t}. Path b t -> RIO App (Path Abs Dir)
fileToDir
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ 
      String
"Processing file " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs File
inFile forall a. Semigroup a => a -> a -> a
<> String
" into dir " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs Dir
outDir
    Path Abs File -> Path Abs Dir -> RIO App ()
processFile Path Abs File
inFile Path Abs Dir
outDir
  where
    fileToDir :: Path b t -> RIO App (Path Abs Dir)
fileToDir = forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath

processFile :: Path Abs File -> Path Abs Dir -> RIO App ()
processFile :: Path Abs File -> Path Abs Dir -> RIO App ()
processFile Path Abs File
inFile Path Abs Dir
outDir = do
  [Text]
fileLines <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m Text
readFileUtf8 (forall b t. Path b t -> String
toFilePath Path Abs File
inFile)
  [ParsedLine]
fileContents <- forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
pooledMapConcurrently Text -> RIO App ParsedLine
parseLine [Text]
fileLines
  String
fileEx <- (String
".snip" forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b. MonadThrow m => Path b File -> m String
fileExtension Path Abs File
inFile
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ 
    String
"File contents for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs File
inFile forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [ParsedLine]
fileContents
  String -> Path Abs Dir -> Word -> [ParsedLine] -> RIO App ()
processContents String
fileEx Path Abs Dir
outDir Word
0 [ParsedLine]
fileContents

processContents :: String -> Path Abs Dir -> Word -> [ParsedLine] -> RIO App ()
processContents :: String -> Path Abs Dir -> Word -> [ParsedLine] -> RIO App ()
processContents String
_ Path Abs Dir
_ Word
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
processContents String
fileExt Path Abs Dir
outDir Word
startCount (StartMarkerLine Maybe (Path Rel File)
mayLbl:[ParsedLine]
rest) = do
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
      String
"Saw the start of snippet for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs Dir
outDir forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
lbl
    Path Abs File
outFile <- (Path Abs Dir
outDir forall b t. Path b Dir -> Path Rel t -> Path b t
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String
lbl forall a. Semigroup a => a -> a -> a
<> String
fileExt)
    forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
concurrently_
      (Path Abs File -> String -> [ParsedLine] -> RIO App ()
processSnip Path Abs File
outFile String
lbl [ParsedLine]
rest)
      (String -> Path Abs Dir -> Word -> [ParsedLine] -> RIO App ()
processContents String
fileExt Path Abs Dir
outDir (Word
startCountforall a. Num a => a -> a -> a
+Word
1) [ParsedLine]
rest)
  where
    lbl :: String
lbl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Show a => a -> String
show Word
startCount) forall b t. Path b t -> String
toFilePath Maybe (Path Rel File)
mayLbl
processContents String
fileExt Path Abs Dir
outDir Word
startCount (ParsedLine
_:[ParsedLine]
rest) = String -> Path Abs Dir -> Word -> [ParsedLine] -> RIO App ()
processContents String
fileExt Path Abs Dir
outDir Word
startCount [ParsedLine]
rest

processSnip :: Path Abs File -> String -> [ParsedLine] -> RIO App ()
processSnip :: Path Abs File -> String -> [ParsedLine] -> RIO App ()
processSnip Path Abs File
outFile String
_ [] =
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
    String
"No contents for snippet for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs File
outFile
processSnip Path Abs File
outFile String
lbl (ParsedLine
EmptyLine:[ParsedLine]
remainingLines) =
  Path Abs File -> String -> [ParsedLine] -> RIO App ()
processSnip Path Abs File
outFile String
lbl [ParsedLine]
remainingLines
processSnip Path Abs File
outFile String
lbl [ParsedLine]
remainingLines = do
  Text
contentT <- (Char -> Bool) -> Text -> Text
T.dropWhile (Char
'\n' forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char
'\n' forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
lbl [ParsedLine]
remainingLines
  forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> Path b Dir
parent Path Abs File
outFile
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
    String
"Snippet for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Path Abs File
outFile forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
contentT
  forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileUtf8 (forall b t. Path b t -> String
toFilePath Path Abs File
outFile) Text
contentT

extractSnipContent :: String -> [ParsedLine] -> RIO App [Text]
extractSnipContent :: String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
extractSnipContent String
_ [ParsedLine
EmptyLine] = forall (m :: * -> *) a. Monad m => a -> m a
return []
extractSnipContent String
lbl (ParsedLine
EmptyLine:[ParsedLine]
rest) = 
  (Text
"" forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
lbl [ParsedLine]
rest
extractSnipContent String
_ (EndMarkerLine Maybe (Path Rel File)
Nothing:[ParsedLine]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return []
extractSnipContent String
lbl (EndMarkerLine (Just Path Rel File
endLbl):[ParsedLine]
rest)
  | String
lbl forall a. Eq a => a -> a -> Bool
== forall b t. Path b t -> String
toFilePath Path Rel File
endLbl = forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
lbl [ParsedLine]
rest
extractSnipContent String
lbl (StartMarkerLine Maybe (Path Rel File)
_:[ParsedLine]
rest) = String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
lbl [ParsedLine]
rest
extractSnipContent String
lbl parsedLines :: [ParsedLine]
parsedLines@(ContentLine (LeadingWS, Text)
_:[ParsedLine]
_) = do
    App{Bool
appDoTrim :: App -> Bool
appDoTrim :: Bool
appDoTrim} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    (Bool -> [Text]
contentLines Bool
appDoTrim forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [ParsedLine] -> RIO App [Text]
extractSnipContent String
lbl [ParsedLine]
rest
  where
    contentLines :: Bool -> [Text]
contentLines Bool
doTrim = Bool -> LeadingWS -> (LeadingWS, Text) -> Text
reduceContent Bool
doTrim LeadingWS
commonLeadingWS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LeadingWS, Text)]
contentSpecs
    reduceContent :: Bool -> LeadingWS -> (LeadingWS, Text) -> Text
reduceContent Bool
False LeadingWS
_ (LeadingWS
lineLeadWS, Text
content) = LeadingWS -> Text
expandWS LeadingWS
lineLeadWS forall a. Semigroup a => a -> a -> a
<> Text
content
    reduceContent Bool
True LeadingWS
comLeadWS (LeadingWS
lineLeadWS, Text
content) =
      case (LeadingWS
comLeadWS, LeadingWS
lineLeadWS) of
        (LeadingWS
_,LeadingWS
NoLeadingWS) -> Text
content
        (LeadingWS
NoLeadingWS,LeadingWS
_) -> LeadingWS -> Text
expandWS LeadingWS
lineLeadWS forall a. Semigroup a => a -> a -> a
<> Text
content
        (LeadingSpaces Word
_, LeadingTabs Word
_) -> Text
content
        (LeadingTabs Word
_, LeadingSpaces Word
_) -> Text
content
        (LeadingSpaces Word
comCnt, LeadingSpaces Word
lineCnt) ->
          LeadingWS -> Text
expandWS (Word -> LeadingWS
LeadingSpaces forall a b. (a -> b) -> a -> b
$ Word
lineCnt forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Word
lineCnt Word
comCnt) forall a. Semigroup a => a -> a -> a
<> Text
content
        (LeadingTabs Word
comCnt, LeadingTabs Word
lineCnt) ->
          LeadingWS -> Text
expandWS (Word -> LeadingWS
LeadingTabs forall a b. (a -> b) -> a -> b
$ Word
lineCnt forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Word
lineCnt Word
comCnt) forall a. Semigroup a => a -> a -> a
<> Text
content
    expandWS :: LeadingWS -> Text
expandWS = \case
      LeadingWS
NoLeadingWS -> Text
""
      LeadingSpaces Word
cnt -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
L.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
cnt) Char
' '
      LeadingTabs Word
cnt -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
L.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
cnt) Char
'\t'
    commonLeadingWS :: LeadingWS
commonLeadingWS = forall a. a -> Maybe a -> a
fromMaybe LeadingWS
NoLeadingWS forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
        (\(LeadingWS, Text)
item Maybe LeadingWS
memo ->
          case ((LeadingWS, Text)
item,Maybe LeadingWS
memo) of
            ((LeadingWS
NoLeadingWS,Text
content), Maybe LeadingWS
_) -> 
              if Text -> Bool
T.null Text
content then
                Maybe LeadingWS
memo
              else 
                forall a. a -> Maybe a
Just LeadingWS
NoLeadingWS
            ((LeadingWS, Text)
_, Just LeadingWS
NoLeadingWS) -> forall a. a -> Maybe a
Just LeadingWS
NoLeadingWS
            ((LeadingWS
lead,Text
_), Maybe LeadingWS
Nothing) -> forall a. a -> Maybe a
Just LeadingWS
lead
            ((LeadingTabs Word
lineCnt,Text
_), Just (LeadingTabs Word
comCnt)) ->
              forall a. a -> Maybe a
Just (Word -> LeadingWS
LeadingTabs forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Word
lineCnt Word
comCnt)
            ((LeadingSpaces Word
lineCnt,Text
_), Just (LeadingSpaces Word
comCnt)) ->
              forall a. a -> Maybe a
Just (Word -> LeadingWS
LeadingSpaces forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Word
lineCnt Word
comCnt)
            ((LeadingTabs Word
_,Text
_), Just (LeadingSpaces Word
_)) ->
              forall a. a -> Maybe a
Just LeadingWS
NoLeadingWS
            ((LeadingSpaces Word
_,Text
_), Just (LeadingTabs Word
_)) ->
              forall a. a -> Maybe a
Just LeadingWS
NoLeadingWS
        )
        forall a. Maybe a
Nothing
        [(LeadingWS, Text)]
contentSpecs
    contentSpecs :: [(LeadingWS, Text)]
contentSpecs = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ ParsedLine -> Maybe (LeadingWS, Text)
mayContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedLine]
contentParsedLines
    ([ParsedLine]
contentParsedLines, [ParsedLine]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span ParsedLine -> Bool
isContentLine [ParsedLine]
parsedLines
    mayContent :: ParsedLine -> Maybe (LeadingWS, Text)
mayContent = \case
        ParsedLine
EmptyLine -> forall a. a -> Maybe a
Just (LeadingWS
NoLeadingWS, Text
"")
        ContentLine (LeadingWS, Text)
spec -> forall a. a -> Maybe a
Just (LeadingWS, Text)
spec
        ParsedLine
_ -> forall a. Maybe a
Nothing
    isContentLine :: ParsedLine -> Bool
isContentLine = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedLine -> Maybe (LeadingWS, Text)
mayContent