isPerfect :: (Integral a) => a -> Bool
isPerfect n = result
  where limit  = ceiling (sqrt (fromIntegral n))
        result = case filter (\k -> n`mod`k == 0) [2..limit] of
          (d1:d2:_) -> n == d1*d2
          [d1]      -> n`div`d1 /= d1
          _         -> False

main = print (length (takeWhile (<=1000000) perfects))
  where perfects = filter isPerfect [6..] :: [Int]