Project Euler Problem 049

import Data.Char
import Data.List
primes :: [Integer]
primes = 2:f [3] [3,5..] where
  f (x:xs) ys = ps ++ f (xs++ps) [z | z<-qs,z`rem`x/=0] where
    (ps,qs) = span (< x*x) ys
factor :: Integer -> [Integer]
factor nn = factorimpl nn primes where
  factorimpl n pri@(p:xs) =
    if p*p>n then [n]
    else if n`rem` p == 0 then
      p:factorimpl (n `quot` p) pri
         else
           factorimpl n xs
isprime 1 = False
isprime n = imp n primes where
  imp n (x:xs) = if x*x>n then True
                 else if rem n x==0 then False
                      else imp n xs      
prime4 :: [Integer]
prime4 = dropWhile (<1000) $ takeWhile (<10000) primes  
s2i :: String -> Integer
s2i n = foldl (\a c -> 10*a+c) 0 $ map (fromIntegral.digitToInt) n
ansl :: [(Integer, Integer, Integer)]
ansl = nub $ sort [ (x,y,z) |
                    x <- prime4,
                    let p=(permutations $ show x)::[String],
                    yy<-p,
                    let y=(s2i yy)::Integer,
                    y > x,
                    isprime y,
                    zz<-p,
                    let z=s2i zz,z>y,
                    isprime z,
                    (z-y)==(y-x)]
ans1 :: [Char]
ans1 = f $ head $ tail ansl where f (a,b,c) = show a++show b++show c
--"296962999629"
main :: IO ()
main = print ans1