{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}

module Euler
  ( Digit
  , Decimal(..)
  , whenM
  , unlessM
  , primesTo
  , primes
  , zipArraysWith
  , RangeIx(..)
  , digitsOf
  , divisors
  , properDivisors
  , toDecimal
  ) where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Control.Monad.Writer
import Data.Array.ST
import Data.Array.Unboxed
import Data.Function
import Data.List
import Data.Word

import qualified Control.Monad.ST.Lazy as LST

type Digit   = Word8
data Decimal = Decimal { integerPart     :: Integer
                       , prefixDigits    :: [Digit]
                       , repeatingDigits :: [Digit]
                       } deriving (Eq,Ord,Show)

whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM   mc m = mc >>= (\c -> when   c m)
unlessM mc m = mc >>= (\c -> unless c m)

primesTo n = LST.runST $ do
   isPrime <- LST.strictToLazyST (newArray (2, n) 1 :: ST s (STUArray s Integer Word8))
   let primesFrom m = if m > n then return [] else do
         p <- LST.strictToLazyST (readArray isPrime m)
         if p == 0 then primesFrom (m+1) else do
            LST.strictToLazyST $ forM_ [2*m,3*m..n] $ \i -> writeArray isPrime i 0
            (m:) <$> primesFrom (m+1)
   primesFrom 2

primes :: [Integer]
primes = let go (!p:xs) = p : go [ x | x <- xs, x `mod` p /= 0 ] in go [2..]

class Ix a => RangeIx a where
   intersectBounds :: (a, a) -> (a, a) -> (a, a)

instance RangeIx Int where
   intersectBounds (al, au) (bl, bu) = (max al bl, min au bu)

instance (RangeIx a, RangeIx b) => RangeIx (a, b) where
   intersectBounds ((al,bl),(au,bu)) ((cl,dl),(cu,du)) =
      ((max al cl, max bl dl), (min au cu, min bu du))

zipArraysWith :: (IArray arrA a, IArray arrB b, IArray arrC c, RangeIx i)
              => (a -> b -> c) -> arrA i a -> arrB i b -> arrC i c
zipArraysWith f as bs = array newRange $ [ (i, f (as!i) (bs!i)) | i <- range newRange ]
   where newRange = intersectBounds (bounds as) (bounds bs)

digitsOf :: (Read a, Show a, Integral a) => a -> [a]
digitsOf = map (read . (:[])) . show

divisors :: Integral a => a -> [a]
divisors n = nub $ concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [1..], let (q, r) = n `divMod` m, r == 0 ]

properDivisors :: Integral a => a -> [a]
properDivisors n | n < 1 = []
properDivisors n = nub $ 1 : concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [2..], let (q, r) = n `divMod` m, r == 0 ]

toDecimal :: Integer -> Integer -> Decimal
toDecimal n m = Decimal q ps rs
   where
      (q,r) = n `divMod` m
      (ps,rs) = toDecimal' r m

toDecimal' :: Integer -> Integer -> ([Digit], [Digit])
toDecimal' n m = first (map fst) $ second (map fst) $ collect [] xs
   where
      xs = [ first fromInteger ((10*x) `divMod` m)
           | x <- takeWhile (/= 0) $ (n:) $ map snd xs ]
      collect ps []     = (ps, [])
      collect ps (x:xs) = if x `elem` ps then break (== x) ps else collect (ps ++ [x]) xs