import Data.List (unfoldr)
import Data.List (find)
import Data.Maybe (listToMaybe)

minus (x:xs) (y:ys) = case (compare x y) of
           LT -> x : minus  xs  (y:ys)
           EQ ->     minus  xs     ys
           GT ->     minus (x:xs)  ys
minus  xs     _     = xs
union (x:xs) (y:ys) = case (compare x y) of
           LT -> x : union  xs  (y:ys)
           EQ -> x : union  xs     ys
           GT -> y : union (x:xs)  ys
union  xs     []    = xs
union  []     ys    = ys

primesToQ m = eratos [2..m]
  where
    eratos []     = []
    eratos (p:xs) = p : eratos (xs `minus` [p*p, p*p+p..m])

combinations 0 _ = [[]]
combinations n xs = [ xs !! i : x | i <- [0..(length xs)-1]
                                  , x <- combinations (n-1) (drop (i+1) xs) ]

pfactors prs n = unfoldr (\(ds,n) -> listToMaybe
     [(x, (dropWhile (< x) ds, div n x)) | x <- takeWhile ((<=n).(^2)) ds ++
                                                   [n|n>1], mod n x==0]) (prs,n)

primes = 2 : 3 : [x | x <- [5,7..], head (pfactors (tail primes) x) == x]

isPrime n = n > 1 &&
              foldr (\p r -> p*p > n || ((n `rem` p) /= 0 && r))
                True primes

is_concatenatable_pair list = isPrime (read(show(list!!0) ++ show(list!!1))) && isPrime (read(show(list!!1) ++ show(list!!0)))

is_concatenatable_set list = and (map is_concatenatable_pair (combinations 2 list))

solution = find is_concatenatable_set (combinations 4 (primesToQ 30000))