88 lines
2.1 KiB
Haskell
88 lines
2.1 KiB
Haskell
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 as T
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.Time.Calendar as D
|
|
import qualified Data.ByteString as B
|
|
import Control.Monad
|
|
|
|
|
|
data MailRecord = MailRecord {
|
|
date :: D.Day,
|
|
voice1 :: T.Text,
|
|
voice2 :: T.Text,
|
|
song1 :: T.Text,
|
|
song2 :: T.Text,
|
|
announcement :: T.Text
|
|
} deriving (Show)
|
|
|
|
seperator :: Char
|
|
seperator = '\t'
|
|
|
|
sepParser :: P.Parser ()
|
|
sepParser = void $ P.char seperator
|
|
|
|
textCellParser :: P.Parser T.Text
|
|
textCellParser = fmap T.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
|
|
announcments <- textCellParser
|
|
return $ MailRecord date voice1 voice2 song1 song2 announcments
|
|
|
|
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 :: T.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 T.Text
|
|
toText t = case T.decodeUtf8' t of
|
|
Left x -> Left $ show x
|
|
Right x -> Right x
|