memo

gistfile1.hs

{-# LANGUAGE TypeFamilies, GADTs, RankNTypes, TypeSynonymInstances, FlexibleInstances, TypeOperators #-}

import Text.Parsec
import Control.Applicative
import Data.Char
import Control.Monad


data Y a
data M a
data D a
data EOF

type YYYY a = Y (Y (Y (Y a)))
type MM   a = M (M a)
type DD   a = D (D a)

class DateTimeParser parser where
    data DateTime parser :: *
    parseDateTime :: String -> parser -> Either ParseError (DateTime parser)

instance DateTimeParser (YYYY (MM (DD EOF))) where
    data DateTime (YYYY (MM (DD EOF))) = YYYYMMDD { year  :: Integer
                                                  , month :: Integer
                                                  , day   :: Integer } deriving Show
    parseDateTime input _ = parse dateTime "yyyy/mm/dd" input


dateTime :: Parsec String u (DateTime (YYYY (MM (DD EOF))))
dateTime = do y <- pyear <* string "/"
              m <- pmonth <* string "/"
              d <- pday m
              return $ YYYYMMDD y m d

iterDigit :: Int -> Parsec String u Integer
iterDigit n = read <$> (replicateM n $ digit)

pyear :: Parsec String u Integer
pyear = iterDigit 4

pmonth :: Parsec String u Integer
pmonth = do m <- iterDigit 2
            guard $ validateMonth m
            return m

validateMonth n = (0 < n) && (n < 13)

pday :: Integer -> Parsec String u Integer
pday month = do day <- iterDigit 2
                guard $ validateDay month day
                return day

validateDay m d = (0 < d) && (d < 32)





-- tryParse1 :: Either ParseError (DateTime (YYYY (MM (DD EOF))))
tryParse1 = parseDateTime "1982/01/01" (undefined :: YYYY (MM (DD EOF)))

-- tryParse2 :: Either ParseError (DateTime (YYYY (MM (DD EOF))))
tryParse2 = parseDateTime "2xxx/01/20" (undefined :: YYYY (MM (DD EOF)))