yet another sudoku solver

Sudoku.hs

module Main where 
import List (unfoldr, transpose, sort, (\\))
import System.Environment (getArgs)
import Control.Monad (foldM,msum)

type Nums = [Int]
solveProblems :: FilePath -> IO ()
solveFile     :: FilePath -> IO ()
solveStr      :: String -> String 
test          :: [[Nums]] -> Maybe [[Nums]]
sep           :: Int -> [Nums] -> [Nums] -> Either (Maybe [[[Nums]]]) [[Nums]]
mtxify        :: [a]->[[a]]
fill,blk,cmp  :: [[Nums]] -> [[Nums]]

main = solveProblems . head =<< getArgs

solveProblems = (mapM_ (putStrLn . solveStr) . parseFile =<<) . readFile
  where parseFile :: String -> [String]
        parseFile =  map (unlines . mtxify . map cnv) . lines
        cnv '.'   = '0'
        cnv c     = c

solveFile = (putStrLn . solveStr =<<) . readFile 

solveStr = maybe "?" (unlines . map show) . test . initStr
  where initStr = map (map getCandidate) . lines
        getCandidate '0' = [1..9]
        getCandidate x   = [read [x]] 

test mtx = either (maybe Nothing (msum . map test)) Just (step $ fill mtx)
  where step mtx = case filter (1 /=) $ concatMap (map length) mtx of 
          []   -> validate mtx
          lens -> sep (minimum lens) [] (concat mtx)

sep _ lft []       = Left Nothing
sep _ lft ([]:xs)  = Left Nothing
sep mx lft (is:xs) | length is == mx = Left $ Just $ map recov is
                   | otherwise       = sep  mx (lft ++ [is]) xs 
  where recov x = mtxify $ lft ++ [[x]] ++ xs

validate mtx
  | and [all validateLn (f mtx) | f <- [blk,transpose,id]] = Right mtx
  | otherwise = Left Nothing
  where validateLn ln = sort (concat ln) == [1..9] 

mtxify = unfoldr f
  where f [] = Nothing
        f xs = Just$ splitAt 9 xs

fill org = fixit $ (transpose . blk . cmp . blk . cmp . transpose . cmp) org
  where fixit result | result == org = result 
                     | otherwise     = fill result

blk = unfoldr f
  where f []           = Nothing
        f ([]:[]:[]:d) = f d 
        f (a:b:c:d)    = let (l,r) = unzip $ map (splitAt 3) [a,b,c] in 
                           Just (concat l, r ++ d)

cmp = map (\x-> (unfoldr $ f $ concat $ filter ((==) 1 . length) x) x)
   where f ones ([i]:is) = Just ([i],is)
         f ones (i:is)   = Just (i \\ ones,is)
         f _ []          = Nothing