import Control.Applicative
import Control.Monad
import qualified Data.List as L
 
replace :: Eq a => a -> a -> [a] -> [a]
replace from to = map f
    where f x | x == from = to
              | otherwise = x
 
blank :: Char
blank = '□'
 
insertWord :: String -> Int -> Int -> [[String]]
insertWord word i j = xs : [L.transpose xs]
    where
      xs = replicate j (replicate (length word + i) blank) ++ [replicate i blank ++ word]
 
blankMatrix :: (Int, Int) -> [String]
blankMatrix (i, j) = [[blank | _ <- [1..j]] | _ <- [1..i]]
 
infixr 2 .||
(.||) :: [String] -> [String] -> [String]
xss1 .|| yss1 = maybe [] id $ f xss1 yss1
    where
      f :: [String] -> [String] -> Maybe [String]
      f (xs:xss) (ys:yss) = (:) <$> g xs ys <*> f xss yss
      f (xs:xss) _        = (:) <$> g xs [] <*> f xss []
      f _        (ys:yss) = (:) <$> g [] ys <*> f [] yss
      f _         _       = Just []
      g :: String -> String -> Maybe String
      g (x:xs) (y:ys) | x == blank = (y:) <$> g xs ys
                      | y == blank = (x:) <$> g xs ys
                      | x == y     = (x:) <$> g xs ys
                      | otherwise  = Nothing
      g (x:xs) _      = (x:) <$> g xs []
      g _      (y:ys) = (y:) <$> g [] ys
      g _      _      = Just []
 
listup :: [String] -> [[String]]
listup xs = foldM f [] xs
    where
      f a x = (a .||) <$> concat [insertWord x i j | i <- [0..len], j <- [0..len]]
      len = sum (map length xs) - (length xs - 1) - 1
 
isCrossWord :: [String] -> [String] -> Bool
isCrossWord wordList matrix = L.sort wordList == L.sort pzWords && checkLen
    where
      pzWords = filter ((>1) . length) . concatMap (words . replace blank ' ') $ matrix ++ xst
      xst = L.transpose matrix
      checkLen = (sum $ map length wordList) - (length wordList - 1) == (sum . map sumc $ matrix)
      sumc xs = foldr (\x a -> if x == blank then a else a + 1) 0 xs
 
getWH :: [String] -> (Int, Int)
getWH xss = (length xss, maximum $ map length xss)
 
findCrossWord :: [String] -> Maybe [String]
findCrossWord wordList =
    liftA2 (.||) id (blankMatrix . getWH) <$> L.find (isCrossWord wordList) (listup wordList)
 
main :: IO ()
main = do
    forM_ [ ["スイカ", "カイバ", "イヌ"], ["マンガ", "バター"] ] $
        putStrLn . maybe "not found." unlines . findCrossWord
 

aW1wb3J0IENvbnRyb2wuQXBwbGljYXRpdmUKaW1wb3J0IENvbnRyb2wuTW9uYWQKaW1wb3J0IHF1YWxpZmllZCBEYXRhLkxpc3QgYXMgTAoKcmVwbGFjZSA6OiBFcSBhID0+IGEgLT4gYSAtPiBbYV0gLT4gW2FdCnJlcGxhY2UgZnJvbSB0byA9IG1hcCBmCiAgICB3aGVyZSBmIHggfCB4ID09IGZyb20gPSB0bwogICAgICAgICAgICAgIHwgb3RoZXJ3aXNlID0geAoKYmxhbmsgOjogQ2hhcgpibGFuayA9ICfilqEnCgppbnNlcnRXb3JkIDo6IFN0cmluZyAtPiBJbnQgLT4gSW50IC0+IFtbU3RyaW5nXV0KaW5zZXJ0V29yZCB3b3JkIGkgaiA9IHhzIDogW0wudHJhbnNwb3NlIHhzXQogICAgd2hlcmUKICAgICAgeHMgPSByZXBsaWNhdGUgaiAocmVwbGljYXRlIChsZW5ndGggd29yZCArIGkpIGJsYW5rKSArKyBbcmVwbGljYXRlIGkgYmxhbmsgKysgd29yZF0KCmJsYW5rTWF0cml4IDo6IChJbnQsIEludCkgLT4gW1N0cmluZ10KYmxhbmtNYXRyaXggKGksIGopID0gW1tibGFuayB8IF8gPC0gWzEuLmpdXSB8IF8gPC0gWzEuLmldXQoKaW5maXhyIDIgLnx8CigufHwpIDo6IFtTdHJpbmddIC0+IFtTdHJpbmddIC0+IFtTdHJpbmddCnhzczEgLnx8IHlzczEgPSBtYXliZSBbXSBpZCAkIGYgeHNzMSB5c3MxCiAgICB3aGVyZQogICAgICBmIDo6IFtTdHJpbmddIC0+IFtTdHJpbmddIC0+IE1heWJlIFtTdHJpbmddCiAgICAgIGYgKHhzOnhzcykgKHlzOnlzcykgPSAoOikgPCQ+IGcgeHMgeXMgPCo+IGYgeHNzIHlzcwogICAgICBmICh4czp4c3MpIF8gICAgICAgID0gKDopIDwkPiBnIHhzIFtdIDwqPiBmIHhzcyBbXQogICAgICBmIF8gICAgICAgICh5czp5c3MpID0gKDopIDwkPiBnIFtdIHlzIDwqPiBmIFtdIHlzcwogICAgICBmIF8gICAgICAgICBfICAgICAgID0gSnVzdCBbXQogICAgICBnIDo6IFN0cmluZyAtPiBTdHJpbmcgLT4gTWF5YmUgU3RyaW5nCiAgICAgIGcgKHg6eHMpICh5OnlzKSB8IHggPT0gYmxhbmsgPSAoeTopIDwkPiBnIHhzIHlzCiAgICAgICAgICAgICAgICAgICAgICB8IHkgPT0gYmxhbmsgPSAoeDopIDwkPiBnIHhzIHlzCiAgICAgICAgICAgICAgICAgICAgICB8IHggPT0geSAgICAgPSAoeDopIDwkPiBnIHhzIHlzCiAgICAgICAgICAgICAgICAgICAgICB8IG90aGVyd2lzZSAgPSBOb3RoaW5nCiAgICAgIGcgKHg6eHMpIF8gICAgICA9ICh4OikgPCQ+IGcgeHMgW10KICAgICAgZyBfICAgICAgKHk6eXMpID0gKHk6KSA8JD4gZyBbXSB5cwogICAgICBnIF8gICAgICBfICAgICAgPSBKdXN0IFtdCgpsaXN0dXAgOjogW1N0cmluZ10gLT4gW1tTdHJpbmddXQpsaXN0dXAgeHMgPSBmb2xkTSBmIFtdIHhzCiAgICB3aGVyZQogICAgICBmIGEgeCA9IChhIC58fCkgPCQ+IGNvbmNhdCBbaW5zZXJ0V29yZCB4IGkgaiB8IGkgPC0gWzAuLmxlbl0sIGogPC0gWzAuLmxlbl1dCiAgICAgIGxlbiA9IHN1bSAobWFwIGxlbmd0aCB4cykgLSAobGVuZ3RoIHhzIC0gMSkgLSAxCgppc0Nyb3NzV29yZCA6OiBbU3RyaW5nXSAtPiBbU3RyaW5nXSAtPiBCb29sCmlzQ3Jvc3NXb3JkIHdvcmRMaXN0IG1hdHJpeCA9IEwuc29ydCB3b3JkTGlzdCA9PSBMLnNvcnQgcHpXb3JkcyAmJiBjaGVja0xlbgogICAgd2hlcmUKICAgICAgcHpXb3JkcyA9IGZpbHRlciAoKD4xKSAuIGxlbmd0aCkgLiBjb25jYXRNYXAgKHdvcmRzIC4gcmVwbGFjZSBibGFuayAnICcpICQgbWF0cml4ICsrIHhzdAogICAgICB4c3QgPSBMLnRyYW5zcG9zZSBtYXRyaXgKICAgICAgY2hlY2tMZW4gPSAoc3VtICQgbWFwIGxlbmd0aCB3b3JkTGlzdCkgLSAobGVuZ3RoIHdvcmRMaXN0IC0gMSkgPT0gKHN1bSAuIG1hcCBzdW1jICQgbWF0cml4KQogICAgICBzdW1jIHhzID0gZm9sZHIgKFx4IGEgLT4gaWYgeCA9PSBibGFuayB0aGVuIGEgZWxzZSBhICsgMSkgMCB4cwoKZ2V0V0ggOjogW1N0cmluZ10gLT4gKEludCwgSW50KQpnZXRXSCB4c3MgPSAobGVuZ3RoIHhzcywgbWF4aW11bSAkIG1hcCBsZW5ndGggeHNzKQoKZmluZENyb3NzV29yZCA6OiBbU3RyaW5nXSAtPiBNYXliZSBbU3RyaW5nXQpmaW5kQ3Jvc3NXb3JkIHdvcmRMaXN0ID0KICAgIGxpZnRBMiAoLnx8KSBpZCAoYmxhbmtNYXRyaXggLiBnZXRXSCkgPCQ+IEwuZmluZCAoaXNDcm9zc1dvcmQgd29yZExpc3QpIChsaXN0dXAgd29yZExpc3QpCgptYWluIDo6IElPICgpCm1haW4gPSBkbwogICAgZm9yTV8gWyBbIuOCueOCpOOCqyIsICLjgqvjgqTjg5AiLCAi44Kk44OMIl0sIFsi44Oe44Oz44KsIiwgIuODkOOCv+ODvCJdIF0gJAogICAgICAgIHB1dFN0ckxuIC4gbWF5YmUgIm5vdCBmb3VuZC4iIHVubGluZXMgLiBmaW5kQ3Jvc3NXb3JkCg==