DateTimeParser.hs

{-# LANGUAGE OverloadedStrings #-}

module DateTimeParser where

import           Control.Applicative
import           Data.Attoparsec.Text hiding (take)
import           Data.Char
import qualified Data.Text            as T

data YMD = YMD Int Int Int deriving Show
data HMS = HMS Int Int Int deriving Show

-- digit は 0 から 9 までの数値を表す
ymdParser :: Parser YMD
ymdParser = do
  y <- countRead 4 digit
  _ <- char '/'
  m <- monthParser
  _ <- char '/'
  d <- dateParser y m
  return $ YMD y m d

hmsParser :: Parser HMS
hmsParser = HMS
            <$> hourParser <* char ':'
            <*> secondMinuiteParser <* char ':'
            <*> secondMinuiteParser

monthParser :: Parser Int
monthParser = oneMonthParser <|> twoMonthParser

oneMonthParser :: Parser Int
oneMonthParser = do
  _ <- char '0'
  y <- digit
  return $ digitToInt y

twoMonthParser :: Parser Int
twoMonthParser = do
  x <- char '1'
  y <- satisfy $ inClass "0-2"
  return $ 10 * digitToInt x + digitToInt y

dateParser :: Int -> Int -> Parser Int
dateParser year month
  | month == 2                     = feburuaryParser year
  | month `elem` [4,6,9,11]        = thirtyParser
  | month `elem` [1,3,5,7,8,10,12] = thirtyOneParser
  | otherwise = undefined

thirtyParser :: Parser Int
thirtyParser = do
  x <- satisfy $ inClass "0-3"
  y <- case x of
         '3' -> char '0'
         _   -> digit
  return $ 10 * digitToInt x + digitToInt y

thirtyOneParser :: Parser Int
thirtyOneParser = do
  x <- satisfy $ inClass "0-3"
  y <- case x of
         '3' -> char '0' <|> char '1'
         _   -> digit
  return $ 10 * digitToInt x + digitToInt y

feburuaryParser :: Int -> Parser Int
feburuaryParser year = do
  x <- satisfy $ inClass "0-2"
  y <- case x of
         '2' -> if isLeapYear year
                then satisfy $ inClass "0-9"
                else satisfy $ inClass "0-8"
         _   -> digit
  return $ 10 * digitToInt x + digitToInt y

isLeapYear :: Int -> Bool
isLeapYear year = year `mod` 4 == 0 && (year `mod` 100 /= 0 || year `mod` 400 == 0)

dateTimeParser :: Parser (YMD, HMS)
dateTimeParser = (,) <$> ymdParser <* char ' ' <*> hmsParser

countRead :: Read a => Int -> Parser Char -> Parser a
countRead i = fmap read . count i

hourParser :: Parser Int
hourParser = do
  x <- satisfy $ inClass "0-2"
  y <- case x of
         '2' -> satisfy $ inClass "0-3"
         _   -> digit
  return $ 10 * digitToInt x + digitToInt y

secondMinuiteParser :: Parser Int
secondMinuiteParser = do
  x <- satisfy $ inClass "0-5"
  y <- digit
  return $ 10 * digitToInt x + digitToInt y

main :: IO ()
main =
  print $ parse dateTimeParser "2000/02/29 23:25:34" `feed` ""