first working commit

app/TableParser.hs

@@ -0,0 +1,88 @@
+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