{-# LANGUAGE OverloadedStrings #-}
module Purebred.Parsing.Text
( parseMailbody
, niceEndOfInput
) where
import Control.Applicative ((<|>))
import qualified Data.Attoparsec.Internal.Types as AT
import Data.Attoparsec.Text
import Text.Wrap (defaultWrapSettings, wrapTextToLines)
import qualified Data.Text as T
import Prelude hiding (Word)
import Control.Lens
import Types
niceEndOfInput :: Parser ()
niceEndOfInput = endOfInput <|> p
where
p = do
c <- peekChar'
off <- offset
fail $ "unexpected " <> show c <> " at offset " <> show off
offset :: AT.Parser i Int
offset = AT.Parser $ \t pos more _lose suc -> suc t pos more (AT.fromPos pos)
parseMailbody ::
Int
-> Source
-> T.Text
-> MailBody
parseMailbody tw s =
either
(\e -> MailBody mempty [Paragraph [Line [] 0 (T.pack e)]])
(MailBody s . setLineNumbers) . parseOnly (paragraphs tw <* niceEndOfInput)
endOfParagraph :: Parser ()
endOfParagraph = endOfLine *> endOfLine
paragraph :: Int -> Parser Paragraph
paragraph tw = Paragraph . makeLines tw . T.pack <$> manyTill anyChar endOfParagraph
paragraphs :: Int -> Parser [Paragraph]
paragraphs tw = do
paras <- many' (paragraph tw)
rest <- takeText
pure $ paras <> [Paragraph $ makeLines tw rest]
makeLines :: Int -> T.Text -> [Line]
makeLines tw = fmap (Line [] 0) . wrapTextToLines defaultWrapSettings tw
setLineNumbers :: [Paragraph] -> [Paragraph]
setLineNumbers = iover (indexing (traversed . pLine)) (set lNumber)