mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2024-10-22 19:39:25 +00:00
87 lines
2.1 KiB
Haskell
87 lines
2.1 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,
|
|
voices :: LT.Text,
|
|
songs :: LT.Text,
|
|
notes :: LT.Text,
|
|
announcement :: LT.Text
|
|
} deriving (Show)
|
|
|
|
seperator :: Char
|
|
seperator = ';'
|
|
|
|
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
|
|
voices <- textCellParser
|
|
sepParser
|
|
songs <- textCellParser
|
|
sepParser
|
|
notes <- textCellParser
|
|
sepParser
|
|
announcement <- textCellParser
|
|
return $ MailRecord{..}
|
|
|
|
parseFirstRow :: P.Parser ()
|
|
parseFirstRow = void (P.string "Datum;Stimmproben;Lieder;Noten;Weitere 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
|