choirMail/app/TableParser.hs

{-# 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