{-# LANGUAGE OverloadedStrings #-}
import Control.Arrow ((***), first, second)
import Control.Monad (ap, forever, guard, join, liftM2)
import Control.Monad.Fix (fix)
import Data.HashSet (fromList, member)
import Data.List (nub, sortBy)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Data.Text (lines, pack, unpack, unwords)
import Data.Text.IO (readFile, putStrLn)
import Prelude hiding (lines, readFile, putStrLn, unwords)

if' x y z = if x then y else z

main = forever . ((putStrLn "Enter a 4x4 grid:" >> ((>>=) `ap` liftM2 (.) (>>=) (ap ((.) . (.) . (>>=)) ((. ((((return .) .) .) . (. ((. ((. return) . (:))) . (.) . (:))) . (.) . (.) . (:))) . (.) . (.) . (>>=)))) (fix ((getLine >>=) . (`ap` (return . take 4)) . flip (if' . (< 4) . length) . (putStrLn "too short, try again" >>)))) >>=) . flip flip getChar . (((>>) . putStrLn . unwords . sortBy (flip (comparing (sum . map (fromJust . flip lookup [('a',1), ('b',4), ('c',3), ('d',2), ('e',1), ('f',2), ('g',3), ('h',3), ('i',1), ('j',6), ('k',5), ('l',2), ('m',4), ('n',2), ('o',1), ('p',4), ('q',8), ('r',1), ('s',1), ('t',1), ('u',3), ('v',4), ('w',4), ('x',8), ('y',2), ('z',8)]) . unpack))) . nub) .) . (. flip ((. (join . drop 2 . flip take (iterate (concatMap (ap ((>>=) . (filter (ap ((&&) . ap ((&&) . (>= 0) . fst) ((<= 3) . fst)) (ap ((&&) . (>= 0) . snd) ((<= 3) . snd))) . flip map [first succ, join (***) succ, second succ, pred *** succ, first pred, join (***) pred, second pred, succ *** pred] . flip id) . last) (ap (ap . (((>>) . guard . not) .) . flip elem) (flip flip [] . ((:) .) . (. return) . (++))) . fix . const)) (([0..3] >>=) . flip flip [] . ((:) .) . flip flip [] . ((:) .) . (,) =<< [0..3])))) . map . (pack .) . map . (`ap` fst) . ((!!) .) . (. snd) . (!!)) 8) . filter . flip member =<< fmap (fromList . lines) (readFile "/usr/share/dict/words")