june 2016 contest code

import Data.List
import Data.Int
import Data.Bits
import Control.Arrow
import System.IO

type Bitmap = Int64
data Problem = Problem {
  rows :: Int,
  cols :: Int,
  field :: Bitmap,
  tiles :: [Bitmap]
}
  
extract :: [String] -> [Problem]
extract ls =
  let groups patt = takeWhile (not . null) . unfoldr (Just . break (patt `isSuffixOf`) .
                                                      dropPatt) where
        dropPatt (s:tl)| patt `isSuffixOf` s = tl
        dropPatt x = x
      texts = groups "=" ls in
   map (single . groups ":") texts where
     single :: [[[Char]]] -> Problem
     single (field:tiles) =
       let m = length field; n = length (head field)
           toBitmap charss = foldr1 (.|.) [if c =='1' then bit (i*n+j) else 0|
                                           (row, i) <- zip charss [0..],
                                           (c, j) <- zip row [0..]] in
       Problem {rows = m, cols = n, field = toBitmap field, tiles = map toBitmap tiles}

solve :: Problem -> [(Int, Int)]
solve problem =
  let m = rows problem; n = cols problem; f = field problem; ts = tiles problem
      combine tile run =
        [(curr .|. shiftL tile (i*n+j), (i,j):coords)| (curr, coords) <- run,
         i <- [0..m-1], j <- [0..n-1]]
      varz = foldr combine [(0,[])] ts
      Just (_,coords) = find ((==) f . fst) varz in
  coords

main = do
  f <- openFile "./input.dat" ReadMode
  hSetEncoding f utf8
  problems <- fmap (extract . filter (not . null) . lines) $ hGetContents f
  putStrLn . unlines . map (unwords . map show . solve) $ problems