Main.hs

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Main where

import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Text.Megaparsec
import Text.Megaparsec.Text.Lazy
import qualified Text.Megaparsec.Lexer as L
import Text.RawString.QQ

data Task =
    Ticket Text Text Double
  | Misc Text Double
  deriving (Eq, Show)

parseTask :: Parser Task
parseTask = parseTicket <|> parseMisc
  where
    parseTicket = Ticket <$> tId <*> tName <*> tHours
    parseMisc = Misc <$> tName <*> tHours

tId :: Parser Text
tId = T.pack . concat <$> sequence [string "#", many digitChar]

tName :: Parser Text
tName = T.strip . T.pack <$> manyTill anyChar (try (lookAhead tHours))

tHours :: Parser Double
tHours = between (string "(") (string "h)") L.float

parseEmail :: Parser [Task]
parseEmail = (++) <$> (skipBeforeTask *> tickets) <*> miscs
  where
    parseTask' :: Parser Task
    parseTask' = parseTask <* some newline

    tickets, miscs :: Parser [Task]
    tickets = someTill parseTask' miscTaskHeader
    miscs = someTill parseTask' (someTill (char '-') newline)

    skipBeforeTask, ticketTaskHeader, miscTaskHeader :: Parser ()
    skipBeforeTask = manyTill anyChar ticketTaskHeader >> newline >> return ()
    ticketTaskHeader = string "[チケット作業]" >> return ()
    miscTaskHeader = string "[チケット外作業]" >> return ()

main :: IO ()
main = print $ parse parseEmail "" sampleText
  where parseEmail' = dbg "debug" parseEmail