import Data.Function
import Data.List
import qualified Data.Set as S


prims = fix (\f (x:xs) -> x:f (filter (\y -> rem y x /= 0) xs)) [2..]

--permu :: Integer -> S.Set Integer
permu :: Integer -> S.Set Integer
permu = S.fromList . map read . permutations . show


primsList = dropWhile (< 1000) $ takeWhile (< 10000) prims
primsSet = S.fromList primsList

candidates :: [[Integer]]
candidates  = map (\prim -> S.toList $ S.intersection primsSet (permu prim)) primsList

candidates' = filter (\x -> 3 <= length x) candidates
candidates'' = map sort candidates'

--permu' :: [a] -> [[a]]
permu' []     = []
permu' (x:xs) = [map permu' y | y <- tails xs]

--permu3 xs = filter (\(a:b:c:[]) -> a < b && b < c && b - a == c - b) $ nub $ map (take 3) $ permutations xs

