Project Euler Problem 050

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
isPrime :: Integer -> Bool
isPrime n = imp n primes where    
  imp n (p:ps) = if n< p*p then True
                    else if n`rem`p==0 then False
                         else imp n ps

inits' :: [a] -> [[a]]
inits' = tail . inits
tails' :: [a] -> [[a]]
tails' = init . tails        
merge :: [[a]] -> [[a]] -> [[a]]
merge a [] = a
merge [] b = b
merge (a:as) (b:bs) | length a>length b = a:merge as (b:bs)
merge a (b:bs) = b:merge a bs
--すべてのシーケンスを、連続した項数の多い順に並べる
seqs :: (Num a, Ord a) => [a] -> [[a]]
seqs l = foldl1' merge $ map tails' $ reverse $ takeWhile ((<(10^6)).sum) $ inits' l
dst :: Integer -> [Integer]
dst n = takeWhile ( (sum x,length x,head x)) $ head $ filter (\x -> let r = sum x in r<(10^6) && isPrime r) $ seqs $ dst (10^6)
-- 997651
main :: IO ()
main = let (a,_,_) = ans1 in print a