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