Its all about New York Minute.

new-york-minute.hs

{-
    This module is all about New Yourk Minutes (NYMs).
    
    NYM is [year, month, day, hour, minute] combination where
     you can uniquely determine who-is-who.
-}

import Control.Monad (guard)

import Data.List (permutations)

{- Finds points (up to minute) in a day which are NYMs. -}
newYorkMinutesOfADay day = do
    hour   <- [0.. 23]
    minute <- [0.. 59]
    
    guard $ isANewYorkMinute $ hour : minute : day
    
    return (hour, minute)

{- 
    The point is a NYM iff there is only 1 way to read it.

    Because "hasCount" don't requests ALL elems of the list, only 
     up to 2 elements are generated.
-}
isANewYorkMinute batch = 
    waysToRead2 batch `hasCount` 1
    
objects `hasCount` n = case (objects, n) of
    ([],     0) -> True
    ([],     n) -> False
    (_ : _,  0) -> False
    (_ : xs, n) -> xs `hasCount` (n - 1)

{- 
    The first attempt to perform a reading.
    Generates a list of length equal to count of ways to read.
    Tries every permutation of a list.
-}
waysToRead parts = do
    [minute, hour, day, month, year] <- permutations parts
    
    guard $ minute <  60
    guard $ hour   <  24
    guard $ month  <= 12
    guard $ day    /=  0 
    guard $ month  /=  0
         
    guard $ day <= lastDay month year

{- 
    Second attempt. Sequentally selects fields, reducing 
     selection pool for later ones.
    Looks faster.
-}
waysToRead2 parts = do
    (hour,   rest) <- parts `split` (< 24)
    (minute, rest) <- rest  `split` (< 60)
    (month,  rest) <- rest  `split` \month -> month > 0 && month <= 12
    (year,   rest) <- rest  `split` const True
    
    day <- rest
    
    guard $ day <= lastDay month year
    
{-
   Takes a list, a predicate and returns a list of element satisfying
    the predicate along with a list of all other elements.
    
   Instance:
    > [1.. 5] `split` odd
    
    [(1,[2,3,4,5]),(3,[1,2,4,5]),(5,[1,2,3,4])]
-}
list `split` pred = split' [] list
  where
    split' accum []       = []
    split' accum (x : xs)
        | pred x    = (x, accum ++ xs) : split' (accum ++ [x]) xs
        | otherwise =                    split' (accum ++ [x]) xs

lastDay month year
    | month == 2 && isLeap year      = 29
    | month == 2                     = 28
    | month `elem` [1,3,5,7,8,10,12] = 31
    | otherwise                      = 30
         
isLeap year =
     year `divs`    4
  && year `notDivs` 100
  || year `divs`    400
  
a `divs` b = a `mod` b == 0

notDivs = (not .) . divs