content: import           Control.Applicative          ((<|>))
  import           Control.Monad
  import           Control.Monad.CSP
  import           Data.List                    (transpose)
  import           System.Environment           (getArgs)
  import           Text.ParserCombinators.ReadP (ReadP)
  import qualified Text.ParserCombinators.ReadP as P
  import           Text.Printf                  (printf)
  
  main :: IO ()
  main = do
      file <- parseArgs
      printf "reading problem file from %s\n" file
      ps <- parseProblems file
      forM_ ps $ \p -> do
          print p
          putStrLn ""
          printSolution $ solve p
          putStrLn ""
  
  -------------------------------------------------------------------------------
  -- parsing
  -------------------------------------------------------------------------------
  
  parseArgs :: IO FilePath
  parseArgs = do
      args <- getArgs
      case args of
          [file] -> return file
          _      -> ioError $ userError "expected exactly one command line argument, the name of the problem file"
  
  data Problem = Problem
      { rows :: [[Int]]
      , cols :: [[Int]]
      } deriving (Show, Read, Eq, Ord)
  
  entryP :: ReadP Int
  entryP = do
      n <- fromEnum <$> P.get
      if n < 65 || n > 90
          then P.pfail
          else return $ n - 64
  
  blankP, eolP :: ReadP Char
  blankP = P.char ' '
  eolP   = P.char '\n'
  
  entriesP :: ReadP [Int]
  entriesP = ([] <$ blankP) <|> P.many1 entryP
  
  lineP :: ReadP [[Int]]
  lineP = P.sepBy1 entriesP blankP <* eolP
  
  problemP :: ReadP Problem
  problemP = Problem <$> lineP <*> lineP
  
  problemsP :: ReadP [Problem]
  problemsP = P.sepBy1 problemP (P.many blankP <* eolP) <* P.eof
  
  parseProblems :: FilePath -> IO [Problem]
  parseProblems file = do
      s <- readFile file
      case P.readP_to_S problemsP s of
          [(ps, "")] -> return ps
          _          -> ioError $ userError $ "error parsing file " <> file
  
  -------------------------------------------------------------------------------
  -- CSP
  -------------------------------------------------------------------------------
  
  solve :: Problem -> [[Bool]]
  solve = oneCSPSolution . problemCSP
  
  problemCSP :: Problem -> CSP r [[DV r Bool]]
  problemCSP p = do
      let rowCount = length $ rows p
          colCount = length $ cols p
      cells <- replicateM rowCount
             $ replicateM colCount
             $ mkDV [False, True]
  
      forM_ (zip cells             $ rows p) $ uncurry rowOrColCSP
      forM_ (zip (transpose cells) $ cols p) $ uncurry rowOrColCSP
  
      return cells
  
  rowOrColCSP :: [DV r Bool] -> [Int] -> CSP r ()
  rowOrColCSP ws [] = forM_ ws $ constraint1 not
  rowOrColCSP ws xs = do
      let vs = zip [0 ..] ws
          n  = length ws
  
      blocks <- forM xs $ \x ->
          mkDV [(i, i + x - 1) | i <- [0 .. n - x]] -- the blocks, given by first and last index
  
      -- blocks must be separate and not overlapping
      f blocks
  
      -- cells in blocks are set
      forM_ blocks $ \x ->
          forM_ vs $ \(i, y) ->
              constraint2 (\(x1, x2) b -> i < x1 || i > x2 || b) x y
  
      -- cells before the first block are not set
      forM_ vs $ \(i, y) ->
          constraint2 (\(y', _) b -> i >= y' || not b) (head blocks) y
  
      -- cells after the last block are not set
      forM_ vs $ \(i, y) ->
          constraint2 (\(_, y') b -> i <= y' || not b) (last blocks) y
  
      -- cells between blocks are not set
      forM_ (zip blocks $ tail blocks) $ \(x, y) ->
          forM_ vs $ \(i, z) ->
              constraint3 (\(_, x') (y', _) b -> i <= x' || i >= y' || not b) x y z
    where
      f :: [DV r (Int, Int)] -> CSP r ()
      f (u : v : bs) = do
          constraint2 (\(_, u') (v', _) -> v' >= u' + 2)  u v
          f $ v : bs
      f _            = return ()
  
  -------------------------------------------------------------------------------
  -- printing
  -------------------------------------------------------------------------------
  
  printSolution :: [[Bool]] -> IO ()
  printSolution bss =
      forM_ bss $ \bs -> do
          forM_ bs $ \b ->
              putChar $ if b then '#' else '.'
          putChar '\n'
  