Project Euler Problem 054

import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import System.IO.Unsafe
--flashはこの2パターンだけ
--[(["AD","6C","6S","7D","TH"],["6H","2H","8H","KH","4H"])]
--[(["7C","4C","9C","2C","5C"],["AS","5D","KD","4D","QH"])]

filedata :: String
filedata = unsafePerformIO $ readFile "054poker.txt"
hands :: [([String], [String])]
hands = map (splitAt 5 . words) $ lines filedata
ans1 :: Int
ans1 = length $ purec hands
main :: IO ()
main = print ans1

purec :: [([String], [String])] -> [Bool]
purec h = filter id $ map battle h
battle :: ([String], [String]) -> Bool
battle (l,r)=(yaku l,tie l)>(yaku r,tie r)
strength :: [Char]
strength = "23456789TJQKA"
val :: [Char]
val = cycle strength
con :: [String] -> ([String], [String])
con = (map head&&&map (head.tail))>>>(join(***)(group.sort))
tolist :: [[Char]] -> [Int]
tolist l = map fromJust $ map ((`elemIndex`strength))$ map head l
tieimpl :: Int -> [[Char]] -> [Int]
tieimpl n l= map head $ filter ((==n).length) $ group $ sortBy (flip compare) $ tolist l
tie :: [[Char]] -> ([Int], [Int], [Int], [Int])
tie l = (tieimpl 4 l,tieimpl 3 l,tieimpl 2 l,tieimpl 1 l)
tr :: ([Int], [Int], [Int], [Int])
tr = tie ["AD","6C","6S","7D","TH"]
ts :: ([Int], [Int], [Int], [Int])
ts = tie ["7C","4C","9C","2C","5C"]
clist :: [[Char]]
clist = take 13 $ map (take 5) $ tails val
consective :: [Char] -> Bool
consective str = let lis@(x:_) = sort $ map (fromJust . (`elemIndex`strength)) str in
  map (subtract x) lis == [0..4]

yaku :: [String] -> Integer
yaku x = rank where
  (l,r) = con x
  conl = sort $ concat l
  rank | (flash_ r && (royal conl)) = 9 --royalsf
       | flash_ r && consective conl  = 8 --sflash_
       | counter l 4 = 7 --four cards
       | fullhouse l = 6 --fullhouse
       | flash_ r= 5 --flush
       | consective conl = 4 --straight
       | counter l 3 = 3 --three cards
       | 2 == length (filter (==2) $ map length l) = 2
       | counter l 2= 1 --one pair
       | otherwise = 0
royal :: [Char] -> Bool
royal s = sort s == "AJKQT"
counter :: [[a]] -> Int -> Bool
counter zz n= maximum (map length zz) == n
fullhouse :: [[a]] -> Bool
fullhouse l = [2,3] == (sort $ map length l)
flash_ :: [[a]] -> Bool
flash_ xx = maximum (map length xx) == 5