choirMail/app/TableParser.hs
2022-11-18 12:09:38 +01:00

90 lines
2.2 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
module TableParser(MailRecord(..), parseBString, parseTable) where
import qualified Text.Parsec as P
-- import qualified Text.Parsec.Char as P
import qualified Text.Parsec.Text as P
import qualified Data.Text.Lazy as LT
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
import qualified Data.Time.Calendar as D
import qualified Data.ByteString as B
import Control.Monad(void)
data MailRecord = MailRecord {
date :: D.Day,
voice1 :: LT.Text,
voice2 :: LT.Text,
song1 :: LT.Text,
song2 :: LT.Text,
announcement :: LT.Text
} deriving (Show)
seperator :: Char
seperator = '\t'
sepParser :: P.Parser ()
sepParser = void $ P.char seperator
textCellParser :: P.Parser LT.Text
textCellParser = fmap LT.pack $ P.many $ P.noneOf [seperator,'\n','\r']
dateCellParser :: P.Parser D.Day
dateCellParser = do
year <- parseYear
_ <- P.char '-'
month <- parseMonth
_ <- P.char '-'
day <- parseDay
return $ D.fromGregorian year month day
parseYear :: P.Parser Integer
parseYear = read <$> P.count 4 P.digit
parseMonth :: P.Parser Int
parseMonth = read <$> P.count 2 P.digit
parseDay :: P.Parser Int
parseDay = read <$> P.count 2 P.digit
parseRow :: P.Parser MailRecord
parseRow = do
date <- dateCellParser
sepParser
voice1 <- textCellParser
sepParser
voice2 <- textCellParser
sepParser
song1 <- textCellParser
sepParser
song2 <- textCellParser
sepParser
announcement <- textCellParser
return $ MailRecord{..}
parseFirstRow :: P.Parser ()
parseFirstRow = void (P.string "Datum\tStimmprobe 1\tStimmprobe 2\tLied 1\tLied 2\tWeitere Ansagen" >> P.endOfLine)
parseTable :: P.Parser [MailRecord]
parseTable = do
parseFirstRow
x <- parseRow `P.sepEndBy` P.endOfLine
P.eof
return x
textToMailRecord :: ST.Text -> Either String [MailRecord]
textToMailRecord t = case P.parse parseTable "" t of
Left x -> Left $ show x
Right x -> Right x
parseBString :: B.ByteString -> Either String [MailRecord]
parseBString t = do
text <- toText t
textToMailRecord text
toText :: B.ByteString -> Either String ST.Text
toText t = case ST.decodeUtf8' t of
Left x -> Left $ show x
Right x -> Right x