import Data.List
import Data.List.Split
import qualified Data.Map as M
import qualified Data.Set as S
(|>) x f = f x

main = interact process

process contents = let
  ls = contents |> lines |> tail
  in solve ls

solve ws = ws |> map shorten |> unlines

shorten word = let
  l = length word
  in if l <= 10 then word
    else (head word):(show (l - 2)) ++ [last word]

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

abbrWord :: String -> String
abbrWord s
    | length s <= 10 = s
    | otherwise      = [head s] ++ show ((-) (length s) 2) ++ [last s]

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    -- print xs
    mapM_ putStrLn $ map abbrWord xs

shorten :: String -> String
shorten s
  | l <= 10 = s
  | otherwise = [head s] ++ (show $ l - 2) ++ [s !! (l - 1)]
  where l = length s

main = do
  n <- getLine
  interact (unlines . map shorten . lines)

-- Vicfred
-- https://codeforces.com/problemset/problem/71/A
-- implementation
import Control.Monad

transform :: String -> String
transform s
    | (length s <= 10) = s
    | otherwise = ([head s] ++ show (length s - 2) ++ [last s])

main :: IO ()
main =  do
    n <- getLine
    inputs <- replicateM (read n) getLine
    let answers = map transform inputs
    sequence_ (map putStrLn answers)

-- Vicfred
-- https://codeforces.com/problemset/problem/71/A
-- implementation
transform :: String -> String
transform s
    | (length s <= 10) = s
    | otherwise = ([head s] ++ show (length s - 2) ++ [last s])

main :: IO ()
main =  interact $ unlines . (map transform) . tail . words

ans :: String -> String
ans s | length s <= 10 = s
      | otherwise = [head s] ++ show (length s - 2) ++ [last s]

main :: IO ()
main = interact $ unlines . map ans . tail . lines

import Control.Monad
main = do
    count <- getLine
    forM_ [1..read count] (\_ -> do
        word <- getLine
        if length word > 10 then
            putStrLn $ [head word] ++ show (length word - 2) ++ [last word]
        else
            putStrLn word)

f x | l > 10 = (head x):(show (l - 2))++[last x]
    | otherwise  = x
    where l = length x
main = interact $ unlines.(map f).tail.words

main :: IO()
main = do
    _ <- getLine
    mapM_ putStrLn . (map trans) . lines =<< getContents
    where
        trans x = if length x < 11 then x
                      else (head x) : (show $ length x - 2) ++ [last x]

-- Vicfred
-- https://codeforces.com/contest/71/problem/A

import Control.Monad

solve :: String -> String
solve s =
    let len = length s
    in if len <= 10
        then s
        else ([head s] ++ show (len - 2) ++ [last s])

main = do
    n <- getLine
    inputs <- replicateM (read n) getLine
    let answers = map solve inputs
    sequence_ (map putStrLn answers)

-- Vicfred
-- Codeforces
-- Way Too Long Words https://codeforces.com/problemset/problem/71/A

main =  do
    w <- getLine
    words <- getContents
    putStrLn . unlines . map transform . lines $ words

transform :: String -> String
transform s
    | (length s <= 10) = s
    | otherwise = ([head s] ++ show (length s - 2) ++ [last s])

module Main where

isTooLong word = length word > 10
lengthBetweenFirstAndLast word = length word - 2
solveCases remainingCases results = do
    word <- getLine
    let result = if isTooLong word then ([head word] ++ (show $ lengthBetweenFirstAndLast word) ++ [last word]) else word
    if remainingCases - 1 > 0 then solveCases (remainingCases - 1) (results ++ [result]) else return (results ++ [result])

main = do
    line <- getLine
    let caseCount = read line :: Int
    results <- solveCases caseCount []
    mapM putStrLn results

f w = let n = length w in if n<11 then w else [w!!0] ++ show (n-2) ++ [w!!(n-1)]

g _ = do
    w <- getLine
    putStrLn . f $ w

main = do
    n <- getLine
    mapM_  g [1..read$n]

import System.IO
import Data.String

readInt :: IO Int
readInt = do
    int <- getLine
    return (read int)

solve n = do
	if n > 0
		then do
			input <- getLine
			if length(input) > 10
				then do
					let len = length(input) - 2
					let str = show len
					putStrLn( ((head input) : []) ++ str ++((last input) : []))
			else putStrLn(input)
			solve(n-1)
		else pure()

main = do
	numberOfTestCases <- readInt
	solve(numberOfTestCases)

import Data.List
f (s:ss) | length ss > 9 = [s]++(show (length ss - 1))++[last ss]
	 | otherwise = s:ss
main = do
	n <- read `fmap` getLine
	mapM_ (\_ -> putStrLn =<< (f `fmap` getLine)) [1..n]

import Control.Applicative
import Control.Monad

solve s = if len > 8 then concat [[f], show len, [l]] else s
	where	len = (length s) - 2
		l = last s
		(f:_) = s

main = do
	sn <- getLine
	let n = read sn :: Int
	res <- forM [1..n]	(\_ -> do
					solve <$> getLine
				)
	mapM putStrLn res
	return ()

import Control.Monad

solve :: String -> String
solve (x:xs) = if length (x:xs) > 10
                  then x : go 0 xs
                  else (x:xs)
    where go n [x] = show n ++ [x]
          go n (x:xs) = go (n + 1) xs

main :: IO ()
main = do
    n <- fmap read getLine
    ss <- replicateM n getLine
    mapM_ putStrLn (map solve ss)

f s = if 10 < length s then
        [head s] ++ show (len s) ++ [last s]
      else
        s
  where len s = length $ init $ tail s

answer (x:xs) = inner (take (read x) xs) []
  where inner [] rv = reverse rv
        inner (x:xs) rv = inner xs (f x:rv)

main = interact
  $ foldl (\x y -> x ++ y ++ "\n") ""
  . answer
  . lines

import Control.Monad

main = do
    lines <- getLine
    let cases = read lines :: Int
    results <- forM [1..cases] (\_ -> do
        line <- getLine
        let result = solve line
        return result)
    mapM putStrLn results

solve :: String -> String
solve s
    | length s <= 10 = s
    | otherwise     = [head s] ++ (show (length s - 2)) ++ [last s]

-- PROBLEM https://cideforces.com/contest/71/problem/A

import Control.Arrow ((>>>))

main :: IO()
main =
  interact $
    lines >>> drop 1 >>> map solve >>> unlines

solve :: String -> String
solve s
  | length s <= 10 = s
  | otherwise = head s : show len ++ [last s]
  where
    len = length s - 2

main = interact w

w = unlines . map f . tail . lines

f s | length s > 10 = [head s] ++ show ( (length s) - 2 ) ++ [last s]
    | otherwise = s

f :: String -> String
f x
  | l <= 10 = x
  | otherwise = [head x] ++ (show (l - 2)) ++ [x !! (l - 1)]
  where l = length x

main = do
  n <- readInt
  a <- readStrN n
  printStrList $ map f a

-- Int from line
readInt :: IO Int
readInt = do
  line <- getLine
  return $ read line

-- Int from N lines
readStrN :: Int -> IO [String]
readStrN 0 = return []
readStrN n = do
  x  <- getLine
  xs <- readStrN (n - 1)
  return (x:xs)

printStrList :: [String] -> IO()
printStrList [] = return ()
printStrList (x:xs) = do
  putStrLn x
  printStrList xs

shorten :: String -> String
shorten s
  | length s <= 10 = s
  | otherwise = [head s] ++ show (length s - 2) ++ [last s]

solve :: String -> String
solve input = unlines $ map shorten $ tail $ lines input

main :: IO ()
main = interact solve

-- RandomUsername (Nikola Jovanovic)
-- Codeforces
-- Way Too Long Words (http://codeforces.com/problemset/problem/71/A)

main = do
    w <- getLine
    words <- getContents
    putStrLn . unlines . solve . lines $ words

solve :: [String] -> [String]
solve xs = foldr change [] xs
    where change x acc
            | (length x <= 10) = x:acc
            | otherwise = ( [head x] ++ lenstr x ++ [last x] ):acc
          lenstr x = show $ length x - 2

-- RandomUsername (Nikola Jovanovic)
-- Codeforces
-- Way Too Long Words (http://codeforces.com/problemset/problem/71/A)

main = do
    w <- getLine
    words <- getContents
    putStrLn . unlines . map transform . lines $ words

solve :: [String] -> [String]
solve xs = foldr change [] xs
    where change x acc
            | (length x <= 10) = x:acc
            | otherwise = ( [head x] ++ lenstr x ++ [last x] ):acc
          lenstr x = show $ length x - 2

transform :: String -> String
transform s
    | (length s <= 10) = s
    | otherwise = ([head s] ++ show (length s - 2) ++ [last s])

module Main where

import Control.Monad (replicateM_)
import Data.Maybe (fromJust)

readNumber :: IO Int
readNumber = read `fmap` getLine

abbreviateWord :: String -> String
abbreviateWord w =
    concat [ firstLetter
           , (show ((length w) - 2))
           , lastLetter ]
  where
    firstLetter = take 1 w
    lastLetter  = take 1 (reverse w)

main :: IO ()
main = do
  nCases <- readNumber
  replicateM_ nCases $ do
    word <- getLine
    putStrLn (if (length word) > 10
              then abbreviateWord word
              else word)

f xs
  | length xs < 11 = xs
  | otherwise = [head xs] ++ l ++ [last xs]
  where l = show (length xs - 2)

main = interact $ unlines . map f . tail . lines

module Main where

--import Debug.Trace

import Control.Monad
import Control.DeepSeq
import Data.Function
import Data.Ratio
import Data.Fixed
import Data.List
import Data.Char

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines = fmap head . sequence . map putStrLn

abbreviate w = abb w 0 where
    abb [c]    n = show (n-1) ++ [c]
    abb (c:cs) 0 = c : abb cs 1
    abb (c:cs) n = abb cs (n+1)

process :: String -> String
process w = if length w > 10 then abbreviate w else w

main = do
    n <- getInt
    lines <- replicateM n getLine
    printLines $ map process lines

import Control.Monad (forM_)

main = (\x -> forM_ [1..x] $ const (((\ y -> if length y > 10 then head y:(show $ length y - 2) ++ last y:[] else y) <$> getLine) >>= putStrLn)) =<< (readLn :: IO Int)

import Control.Applicative
import Control.Monad

onecase= do
		x<-getLine
		let s= length x
		putStrLn $ if s <=10 then  x else  ( [head x ] ++show(s-2) ++[last x])

main= do
	w<- read <$> getLine:: IO Int
	replicateM_ w onecase

main = do
  n <- readLn
  arr <- sequence (replicate  n getLine)
  let b = fmap shrt arr
  mapM putStrLn b

shrt :: String -> String
shrt x = if length x <= 10 then x else ((head x) : (show $ length x - 2) ++ (last x :[]))

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

text = [ "4"
       , "word"
       , "localization"
       , "internationalization"
       , "pneumonoultramicroscopicsilicovolcanoconiosis"
       ]

f text = if len > 10 then  [f] ++ show (len - 2) ++ [l] else text
    where
      len = length text
      f   = head text
      l   = last text

main :: IO ()
main = do { _:ts <- lines <$> getContents
          ; mapM_ (printf "%s\n") . map f $ ts
          }

import           Control.Monad                  ( replicateM
                                                , foldM
                                                )

solve :: String -> String
solve s
    | length s <= 10 = s
    | otherwise      = abbr s
    where
        abbr :: String -> String
        abbr s = (head s):[] ++ show (length s - 2) ++ (last s):[]

main :: IO ()
main = do
    n <- getInt
    lines <- replicateM n getLine
    mapM_ (putStrLn . solve) lines

    where
        getInt :: IO Int
        getInt = do
            line <- getLine
            return ( read line :: Int )

process :: Int -> String -> String
process n str
    | len > n = [head str] ++ show (len-2) ++ [last str]
    | otherwise = str
    where len = length str

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    strs <- fmap lines getContents
    sequence . map (putStrLn . process 10) $ strs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.Int
import Data.Bits
import Data.Ratio
import Data.IORef
-- import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf
-- import Debug.Trace
import System.Exit

solveCase t n
  | t == n = return ()
  | otherwise = getLine >>= putStrLn . solve >> solveCase (t + 1) n
  where
    solve s | l <= 10 = s
            | otherwise = [head s] ++ show (l - 2) ++ [last s]
            where
              l = length s

main = (readLn :: IO Int) >>= solveCase 0

import Control.Monad

solve :: String -> String
solve s =
    let len = length s
    in if len <= 10
        then s
        else ([s!!0] ++ (show(len - 2)) ++ [s!!(len-1)])

main :: IO ()
main = do
    n <- getLine
    inputs <- replicateM (read n) getLine
    let answers = map solve inputs
    sequence_ (map putStrLn answers)

import Control.Monad
f str@(x:xs)
	| length str > 10 = x : show (length str - 2) ++ [last str]
	| otherwise = str

main = do
	n <- readLn
	replicateM_ n (do
		s <- getLine
		putStrLn (f s))

-- http://codeforces.com/problemset/problem/71/A

abbreviate :: String -> String
abbreviate w =
  if length w <= 10
    then w
    else [head w] ++ show ((length w) - 2) ++ [last w]

main = do
  n <- getLine
  contents <- getContents
  putStr $ unlines $ map abbreviate $ lines contents

import Control.Monad

abbreviate s
    | length s <= 10 = s
    | otherwise = head s : show(length s - 2) ++ [last s]

main = do
    n <- readLn
    replicateM_ n $ do
        s <- getLine
        putStrLn $ abbreviate s

main :: IO ()
main = interact $ output

compactWord :: String -> String
compactWord x = firstLetter x ++ middleSize x ++ endLetter x
                where
                  firstLetter x = take 1 x
                  middleSize x  = (show . length) (init $ tail x)
                  endLetter x   = drop ((length x) - 1) x

transformWord :: String -> String
transformWord x | (length x) > 10 = compactWord x
                | otherwise       = x

input :: [String] -> [String]
input inputWords = map transformWord inputWords

output :: String -> String
output = unlines . input . tail . lines

f s
    | l > 10 = (head s : show (l - 2)) ++ [last s]
    | otherwise = s
    where
        l = length s

main = interact $ unlines.map f.tail.lines

import Control.Monad

readNLines :: Int -> IO [String]
readNLines n = replicateM n getLine

checkAndConstructWord :: String -> String
checkAndConstructWord x
        | length x > 10 = (charToString $ head x)++(show $ length x - 2)++(charToString $ x!!(length x - 1))
        | otherwise = x
    where charToString y = [y]

main :: IO()
main = do
    n <- readLn :: IO Int
    x <- readNLines n
    mapM_ putStrLn $ map checkAndConstructWord x

import Control.Monad

main = do
    n <- getLine
    let times = read n ::Int
    forM [1..times] (\i -> do
        word <- getLine
        putStrLn $ waytoolong word)

waytoolong :: String -> String
waytoolong w
    | length w <= 10 = w
    | otherwise     = head w : (show $ length w - 2) ++ [last w]

import Prelude

toInt::[String] -> Integer
toInt (x:xs) = read x

firs::[Char] -> Char
firs = head

las::[Char] -> Char
las = firs . reverse

cnt::[Char] -> Integer
cnt [] = (-2)
cnt (x:xs) = 1 + (cnt xs)

func::Integer -> IO ()
func 0 = return ()
func x = do
    input <- getLine
    putStrLn $ if ((cnt input) > 8) then ([firs input]++(show (cnt input))++[las input]) else input
    func (x-1)

main = do
	input <- getLine
	let n = toInt (words input)
	func n

main = do
    getLine
    as <- fmap lines getContents
    let
        bs = map f as
        f s
            | length s <= 10 = s
            | otherwise = [head s] ++ (show $ length s - 2) ++ [last s]

    putStr $ unlines $ bs

main = do
	n <- getLine
	interact$ (unlines.map s).lines
s a
	| length a > 10 = [head a] ++ show ((length a)-2) ++ [last a]
	| otherwise = a

import Data.List
main = interact $ intercalate "\n" . map solve . tail . lines
solve xs
    | length xs > 10 = [head xs] ++ (show . (subtract 2) . length $ xs) ++ [last xs]
    | otherwise      = xs

s :: String -> String
s word =
  if length word <= 10
  then word
  else h ++ [last word]
  where
    h = head word : (show $ (length word) - 2)

solve :: Int -> [String] -> [String]
solve 1 (x:_) = [s x]
solve n (x:xs) = s x : solve (n - 1) xs

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

main = do
  (n:_) <- readInts
  c <- getContents
  putStrLn (unlines $ solve n (lines c))

import Data.Maybe
import Control.Monad

main = do
    numCasesLine <- getLine
    let numCases = (read numCasesLine) :: Int in replicateM_ numCases processCase
        where
            processCase = do
                line <- getLine
                if length line > 10
                    then putStrLn $ (head line) : show ((length line) - 2) ++ [last line]
                    else putStrLn line

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Monad

getInt = fst . fromJust . B.readInt

procWord w
    | l <= 10 = w
    | otherwise = (head w) : (show $ l - 2) ++ [last w]
    where
        l = length w

main = do
    n <- getInt <$> B.getLine
    replicateM_ n $ fmap procWord getLine >>= putStrLn

import System.IO (readFile, getLine)
import Data.Char (digitToInt)
import Data.List (intercalate)
import Control.Monad (sequence)
import Text.Printf (printf)

abr_internal :: Int -> String -> Maybe (Int, Char)
abr_internal n [h] = Just (n + 1, h)
abr_internal n (h:s) = abr_internal (n + 1) s
abr_internal n [] = Nothing

abbreviate :: String -> String
abbreviate s = case abr_internal 0 s of
                    Nothing -> error "Invalid string passwd"
                    (Just (n, c)) -> if n > 10 then (head s) : (printf "%d" (n - 2)) ++ [c] else s

abbreviateInput :: Int -> IO [String]
abbreviateInput n | n <= 0 = return ([] :: [String])
                  | otherwise = do
                        s <- getLine
                        rtail <- abbreviateInput (n-1)
                        return ((abbreviate s) : rtail)

main = do
    cnt_s <- getLine
    result <- abbreviateInput ((read cnt_s) :: Int)
    mapM putStrLn result

import System.IO
main =
  do
    n <- readLn :: IO Int
    f n

f 0 = return ()
f n =
  do
    s <- getLine
    --let s = read t :: String
    if length s <= 10
       then putStrLn s
       else let str = head s : show (length s - 2) ++ [last s]
                in putStrLn str
    f (n-1)

extract (x:xs)=take (read x::Int) xs
f x
	|l<=10 = x
	|otherwise   = head x:(show (l-2)++[last x])
	where l=length x
main=interact$unlines.map f.extract.lines

{-# LANGUAGE CPP, TemplateHaskell #-}

module Main (
    main
) where

import Control.Monad (unless)
import Data.List (stripPrefix)
import System.Exit (exitFailure)

#ifdef MAIN_FUNCTION
import Test.Framework.TH
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2

import Test.QuickCheck
import Test.HUnit

import Data.List
#endif

abbrevate all@(h:s)
    | len <=10 = all
    | otherwise = [h] ++ show (len - 2) ++ [head $ reverse s]
    where len = length all

process 0 = do
    return ()
process n = do
    s <- getLine
    putStrLn (abbrevate s)
    process (n-1)

exeMain = do
    [n] <- (map read . words) `fmap` getLine

    process n

-- Tests --

#ifdef MAIN_FUNCTION
testMain = $(defaultMainGenerator)

#endif

#ifndef MAIN_FUNCTION
#define MAIN_FUNCTION exeMain
#endif
main = MAIN_FUNCTION

    main=interact$unlines.map f.tail.lines
    l=length
    f x|l x<11=x|1>0=(head x:show(l x-2))++[last x]

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Text.Printf

main = do
  n <- read <$> getLine
  mapM_ (\_ -> do
    s <- getLine
    let m = length s
    if m > 10 then
      printf "%c%d%c\n" (head s) (m-2) (last s)
    else putStrLn s
    ) [1..n]

module Main where

main :: IO ()
main = do
  n <- getLine
  let
    go n =
      if n == 0 then
        return ()
      else do
        line <- getLine
        (putStrLn . shortenString) line
        go $ n - 1
  go $ read n

shortenString :: String -> String
shortenString string = let
  helper :: Int -> String -> String
  helper n (char : "")
    | n > 9              = head string : (show $ n - 1) ++ [char]
    | otherwise           = string
  helper n (char : chars) = helper (n + 1) chars
  in helper 0 string

clear xs = [x | x <- xs, x /= '\'']

solve :: [Char] -> String

solve x
	| len <= 10 = x
	| otherwise = clear (show (x !! 0) ++ (show (len-2)) ++ (show (x !! (len-1))))
	where len = length x

main = interact $ unlines . map solve . tail . words

import Data.Char
import Data.List

ans str = if l<11 then str
               else [head str] ++ show (l-2) ++ [last str]
    where l = length str
main=do
    input<-getContents
    putStr.unlines $ map ans $tail.lines $ input

main=interact$unlines.map f.tail.lines
f l@(x:xs)
	|length l<=10 = l
	|otherwise = [x] ++ (show ((length l)-2)) ++ [last xs]

import Control.Monad

main :: IO ()
main = do
    n <- getLine
    inputs <- replicateM (read n) getLine
    mapM_ putStrLn $ fmap abbreviate inputs

abbreviate :: String -> String
abbreviate s
    | l <= 10 = s
    | otherwise = [head s] ++ show (l - 2) ++ [last s]
    where l = length s

solve s
    | l > 10    = [head s] ++ (show (l-2)) ++ [last s]
    | otherwise = s
  where
    l = length s
main = putStrLn . unlines . map solve . tail . lines =<< getContents

import Control.Monad
main=do
 n<-fmap read getLine
 replicateM_ n$getLine>>=putStrLn.q
q s|t<=10=s
 |True=head s:(show$t-2)++[last s]
 where t=length s

import Control.Monad

main = do
    line <- getLine
    let count = read line :: Int
    replicateM_ count $ getLine >>= putStrLn . solve

solve :: String -> String
solve s = solve' s $ length s
    where solve' s len | len <= 10 = s
                       | otherwise = head s : (show $ len - 2) ++ [last s]

import Control.Monad

main = do
    n <- fmap read getLine
    replicateM_ n $ getLine >>= putStrLn . solve

solve s | len <= 10 = s
        | otherwise = head s : (show $ len - 2) ++ [last s]
    where
        len = length s

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  replicateM_ n $ do
    q <- B.getLine
    let r = simplify . head . C.words $ q
    -- C.putStrLn . C.pack . show $ (B.length q)
    C.putStrLn r

simplify :: B.ByteString -> B.ByteString
simplify s = sim s (B.length s)
  where
    sim s l
      | l <= 10 = s
      | otherwise = B.concat $ [prefix s, intToBs (l - 2), suffix s]
    prefix = B.singleton . B.head
    suffix = B.singleton . B.last
    intToBs i = C.pack . show $ i

import Data.Char

transformWord :: String -> String
transformWord word
    | (length word <= 10) = word
    | otherwise = [head word] ++ (show $ length word - 2) ++ [last word]

getWords :: Integer -> IO [[Char]]
getWords wordsLeft = do
    if wordsLeft == 0
        then return []
    else do
        line <- getLine
        stuff <- getWords (wordsLeft - 1)
        return (line : stuff)

printWords [] = return ()
printWords wordsList = do
    putStrLn $ head wordsList
    printWords $ tail wordsList

main = do
    line <- getLine
    let numWords = read line :: Integer
    wordsList <- getWords numWords
    let newWords = map transformWord wordsList
    printWords newWords

main=interact$unlines.map f.tail.lines
l=length
f x|l x<11=x|1>0=(head x:show(l x-2))++[last x]

import Control.Applicative

process x | length x <=10  = x
          | otherwise = [head x]++ (show (length x -2))++ [last x]

main=do
  x<-tail .lines <$> getContents
  mapM_ putStrLn $ map process x

convertStr contents = if (length contents) > 10 then putStr ([(contents !! 0)] ++ (show ((length contents) - 2)) ++ [(contents !! ((length contents) - 1))] ++ "\n") else putStr (contents ++ "\n")

outputI18 1 = do
    contents <- getLine
    convertStr contents
outputI18 n = do
    contents <- getLine
    convertStr contents
    outputI18 (n-1)

main = do
    input1 <- getLine
    let n = (read input1 :: Int)
    outputI18 n

main = do
    rs <- getLine
    putStr (result rs)

result rs
  | length rs > 10 = (head rs):(long rs) ++ ((last rs):[])
  | otherwise = rs

long rs = show (length rs - 2)

main = getContents>>=mapM_ print.map slv.tail.words
slv w
    | len > 10 = head w : (show $ len-2) ++ [last w]
    | True = w
    where len = length w

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  replicateM_ n $ do
    r <- B.getLine
    let s = simplify r
    C.putStrLn s

solve = (C.putStrLn)

simplify :: B.ByteString -> B.ByteString
simplify s = sim s (B.length s)
  where
    sim :: B.ByteString -> Int -> B.ByteString
    sim s l
      | l < 10 = s
      | otherwise =
        B.concat $
        [ B.singleton . B.head $ s
        , C.pack . show $ (l - 2) :: B.ByteString
        , (B.singleton . B.last $ s)
        ]

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  replicateM_ n $ do
    q <- B.getLine
    let r = simplify . head . C.words $ q
    -- C.putStrLn . C.pack . show $ (B.length q)
    C.putStrLn r

simplify :: B.ByteString -> B.ByteString
simplify s = sim s (B.length s)
  where
    sim s l
      | l < 10 = s
      | otherwise = B.concat $ [prefix s, intToBs (l - 2), suffix s]
    prefix = B.singleton . B.head
    suffix = B.singleton . B.last
    intToBs i = C.pack . show $ i

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  replicateM_ n $ do
    q <- B.getLine
    let r = simplify . strip $ q
    C.putStrLn r

strip = B.filter (\s -> s /= (B.head " "))

simplify :: B.ByteString -> B.ByteString
simplify s = sim s (B.length s)
  where
    sim s l
      | l < 10 = s
      | otherwise = B.concat $ [prefix s, intToBs (l - 2), suffix s]
    prefix = B.singleton . B.head
    suffix = B.singleton . B.last
    intToBs i = C.pack . show $ i

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  replicateM_ n $ do
    q <- B.getLine
    let r = simplify . strip $ q
    C.putStrLn . C.pack . show $ (B.length q)
    C.putStrLn r

strip = B.filter (\s -> s /= (B.head " "))

simplify :: B.ByteString -> B.ByteString
simplify s = sim s (B.length s)
  where
    sim s l
      | l < 10 = s
      | otherwise = B.concat $ [prefix s, intToBs (l - 2), suffix s]
    prefix = B.singleton . B.head
    suffix = B.singleton . B.last
    intToBs i = C.pack . show $ i

import Data.Char

transformWord :: String -> String
transformWord word
    | (length word <= 10) = word
    | otherwise = [head word] ++ (show $ length word) ++ [last word]

getWords :: Integer -> IO [[Char]]
getWords wordsLeft = do
    if wordsLeft == 0
        then return []
    else do
        line <- getLine
        stuff <- getWords (wordsLeft - 1)
        return (line : stuff)

printWords [] = return ()
printWords wordsList = do
    putStrLn $ head wordsList
    printWords $ tail wordsList

main = do
    line <- getLine
    let numWords = read line :: Integer
    wordsList <- getWords numWords
    let newWords = map transformWord wordsList
    printWords newWords

import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString as B
import Control.Arrow

solve :: B.ByteString -> B.ByteString
solve s
    | B.length s > 10 = B.snoc (B.cons (B.head s) (B8.pack (show $ B.length s - 2))) (B.last s)
    | otherwise     = s

main :: IO ()
main = B.interact $
   B8.lines >>> map solve . tail >>> B8.unlines

import Control.Arrow

solve :: String -> String
solve s@(x:xs)
    | length s > 10 = [x] ++ show (length s - 2) ++ [last s]
    | otherwise     = s

main :: IO ()
main = interact $
   lines >>> map solve >>> unlines

import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString as B
import Control.Arrow

solve :: B.ByteString -> B.ByteString
solve s
    | B.length s > 10 = B8.snoc (B8.cons (B8.head s) (B8.pack (show $ B8.length s - 2))) (B8.last s)
    | otherwise       = s

main :: IO ()
main = B.interact $
   B8.lines >>> map solve . tail >>> B8.unlines

import Control.Monad

genAns s
  | n < 10 = s
  | otherwise = a:(show (n-2)) ++ [b]
  where
    n = length s
    (a,b) = (head s, last s)

main = do
  n <- readLn :: IO Int
  forM_ [1..n] $ \i -> do
    aa <- getLine
    putStrLn $ genAns aa

module Main where

main :: IO ()
main = interact $ unlines . map solve . tail . words

solve :: String -> String
solve xs
    | len <= 10 = xs
    | otherwise = [head xs] ++ show len ++ [last xs]
    where len = length xs

g :: [Char] -> [Char]
g s
    | length s > 10 = [head s] ++ (show . length $ s) ++ [last s]
    | otherwise     = s

main = interact $ tail . init . show . g

import Control.Monad

solve :: String -> String
solve s =
    let len = length s
    in if len < 10
        then s
        else ([s!!0] ++ (show(len - 2)) ++ [s!!(len-1)])

main :: IO ()
main = do
    n <- getLine
    inputs <- replicateM (read n) getLine
    let answers = map solve inputs
    sequence_ (map putStrLn answers)

import Control.Applicative

solve xs
  |length xs <= 10 = xs
  |otherwise = abbr xs

abbr xs = (take 1 xs) ++ show (length xs - 2) ++ (take 1 $ reverse xs)

main = do
  result <- map solve . tail . lines <$> getContents
  print result

import Control.Applicative

solve xs
  |length xs < 10 = xs
  |otherwise = abbr xs

abbr xs = (take 1 xs) ++ show (length xs - 2) ++ (take 1 $ reverse xs)

main = do
  result <- unlines . map solve . lines . tail <$> getContents
  putStrLn result

import Control.Applicative

solve xs
  |length xs <= 10 = xs
  |otherwise = abbr xs

abbr xs = (take 1 xs) ++ show (length xs - 2) ++ (take 1 $ reverse xs)

main = do
  result <- unlines . map solve . lines . tail <$> getContents
  putStrLn result

import Control.Monad

main = do
    n <- getLine
    let times = read n ::Int
    forM [1..times] (\i -> do
        word <- getLine
        putStrLn $ waytoolong word)

waytoolong :: String -> String
waytoolong w
    | length w <= 4 = w
    | otherwise     = head w : (show $ length w - 2) ++ [last w]

main = do
    getLine
    as <- fmap lines getContents
    let
        bs = map f as
        f s
            | length s > 10 = s
            | otherwise = [head s] ++ (show $ length s - 2) ++ [last s]

    putStr $ unlines $ bs

main = do
	n <- getLine
	interact$ (unlines.map s).lines
s a
	| length a > 10 = [head a] ++ (show (length a)) ++ [last a]
	| otherwise = a

import Data.List
main = interact $ intercalate "\n" . map solve . tail . lines
solve xs
    | length xs > 10 = [head xs] ++ (show . length $ xs) ++ [last xs]
    | otherwise      = xs

s :: Int -> String -> String
s n word =
  if length word <= n
  then word
  else h ++ [last word]
  where
    h = head word : (show $ (length word) - 2)

solve :: Int -> [String] -> [String]
solve n words =
  map (s n) words

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

main = do
  (n:_) <- readInts
  c <- getContents
  putStrLn (unlines $ solve n (lines c))

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Monad

main = do
    numCases <- fst . fromJust . B.readInt <$> B.getLine
    replicateM_ numCases processCase
    where
        processCase = do
            line <- B.getLine
            if B.length line > 10
                then putStrLn $ (B.head line) : show ((B.length line) - 2) ++ [B.last line]
                else putStrLn . tail . init . show $ line

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Monad

main = do
    numCases <- fst . fromJust . B.readInt <$> B.getLine
    replicateM_ numCases processCase
    where
        processCase = do
            line <- B.getLine
            if B.length line > 10
                then putStrLn $ (B.head line) : show ((B.length line) - 2) ++ [B.last line]
                else putStrLn . tail . init . init . show $ line

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Monad

main = do
    numCases <- fst . fromJust . B.readInt <$> B.getLine
    replicateM_ numCases processCase
    where
        processCase = do
            line <- B.getLine
            if B.length line > 10
                then putStrLn $ (B.head line) : show ((B.length line) - 2) ++ [B.last line]
                else putStrLn . tail . init . init. init . show $ line

import System.IO (readFile, getLine)
import Data.Char (digitToInt)
import Data.List (intercalate)
import Control.Monad (sequence)
import Text.Printf (printf)

abr_internal :: Int -> String -> Maybe (Int, Char)
abr_internal n [h] = Just (n, h)
abr_internal n (h:s) = abr_internal (n + 1) s
abr_internal n [] = Nothing

abbreviate :: String -> String
abbreviate s = case abr_internal 0 s of
                    Nothing -> error "Invalid string passwd"
                    (Just (n, c)) -> if n > 10 then (head s) : (printf "%d" (n - 1)) ++ [c] else s

abbreviateInput :: Int -> IO [String]
abbreviateInput n | n <= 0 = return ([] :: [String])
                  | otherwise = do
                        s <- getLine
                        rtail <- abbreviateInput (n-1)
                        return ((abbreviate s) : rtail)

main = do
    cnt_s <- getLine
    result <- abbreviateInput ((read cnt_s) :: Int)
    mapM putStrLn result

import System.IO
main =
  do
    n <- readLn :: IO Int
    f n

f 0 = return ()
f n =
  do
    s <- getLine
    --let s = read t :: String
    if length s < 10
       then putStrLn s
       else let str = head s : show (length s - 2) ++ [last s]
                in putStrLn str
    f (n-1)

extract (x:xs)=take (read x::Int) xs
f x
	|l<=4 = x
	|otherwise   = head x:(show (l-2)++[last x])
	where l=length x
main=interact$unlines.map f.extract.lines

import Control.Monad

cutString :: String -> String
cutString s
  | (length s) > 10 = [head s] ++ (show ((length s) - 2)) ++ [last s]
  | otherwise = s

readInt :: IO Int
readInt = readLn

main :: IO ()
main = do
  n <- readInt
  strings <- replicateM n getLine
  print $ map cutString strings

main = getLine >> getContents >>= putStrLn . unlines . inout . lines

inout :: [String] -> [String]
inout str = map (func) str

func :: String -> String
func wrd = if length wrd < 9 then wrd else codWrd wrd

codWrd :: String -> String
codWrd wrd = head wrd : cutWrd wrd ++ last wrd :[]
			where cutWrd = show . length . init . tail

main = getLine >> getContents >>= putStrLn . unlines . inout . lines

inout :: [String] -> [String]
inout str = map (func) str

func :: String -> String
func wrd = if length wrd < 10 then wrd else codWrd wrd

codWrd :: String -> String
codWrd wrd = head wrd : cutWrd wrd ++ last wrd :[]
			where cutWrd = show . length . init . tail

{-# LANGUAGE CPP, TemplateHaskell #-}

module Main (
    main
) where

import Control.Monad (unless)
import Data.List (stripPrefix)
import System.Exit (exitFailure)

#ifdef MAIN_FUNCTION
import Test.Framework.TH
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2

import Test.QuickCheck
import Test.HUnit

import Data.List
#endif

abbrevate all@(h:s)
    | len <=10 = all
    | otherwise = [h] ++ show (len - 2) ++ [head $ reverse s]
    where len = length all

process 0 = do
    return ()
process n = do
    s <- getLine
    print (abbrevate s)
    process (n-1)

exeMain = do
    [n] <- (map read . words) `fmap` getLine

    process n

-- Tests --

#ifdef MAIN_FUNCTION
testMain = $(defaultMainGenerator)

#endif

#ifndef MAIN_FUNCTION
#define MAIN_FUNCTION exeMain
#endif
main = MAIN_FUNCTION

f s
  | length s < 10 = s
  | otherwise = head s:show (l-2) ++ [last s]
  where l = length s
main =
    interact $ unlines.map f .tail.lines

f s
  | length s < 10 = s
  | otherwise = head s:show (l-2) ++ [last s]
  where l = length s
main =
    interact $ unlines.map f .lines

len [] = 0
len (x:xs) = (len xs) + 1

llast [x] = x
llast (x:xs) = llast xs

solve (x:xs) | (len xs - 1) > 4 = [x] ++ show (len xs - 1) ++ [llast xs]
             | otherwise        = [x] ++ xs

doSolve 0 = putStr ""
doSolve n = do
	line <- getLine
	putStrLn (solve line)
	doSolve (n-1)

main = do
	line <- getLine
	doSolve (read line :: Integer)

len [] = 0
len (x:xs) = (len xs) + 1

llast [x] = x
llast (x:xs) = llast xs

solve (x:xs) | (len xs) > 10 = [x] ++ show (len xs - 1) ++ [llast xs]
             | otherwise     = [x] ++ xs

doSolve 0 = putStr ""
doSolve n = do
	line <- getLine
	putStrLn (solve line)
	doSolve (n-1)

main = do
	line <- getLine
	doSolve (read line :: Integer)

len [] = 0
len (x:xs) = (len xs) + 1

llast [x] = x
llast (x:xs) = llast xs

solve (x:xs) | (len xs - 1) > 10 = [x] ++ show (len xs - 1) ++ [llast xs]
             | otherwise         = [x] ++ xs

doSolve 0 = putStr ""
doSolve n = do
	line <- getLine
	putStrLn (solve line)
	doSolve (n-1)

main = do
	line <- getLine
	doSolve (read line :: Integer)

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Text.Printf

main = do
  n <- read <$> getLine
  mapM_ (\_ -> do
    s <- B.getLine
    let m = B.length s
    if m > 10 then
      printf "%c%d%c\n" (B.head s) (m-2) (B.last s)
    else B.putStrLn s
    ) [1..n]

abbreviate :: String -> String
abbreviate input
  | (length input) <= 10 = input
  |  otherwise = (\str -> [head str] ++ (show $ (length str) - 2) ++ [last str]) input

main = interact abbreviate

module Main where

main :: IO ()
main = do
  n <- getLine
  let
    go n =
      if n == 0 then
        return ()
      else do
        line <- getLine
        (putStrLn . shortenString) line
        go $ n - 1
  go $ read n

shortenString :: String -> String
shortenString string = let
  helper :: Int -> String -> String
  helper n (char : "")
    | n > 10              = head string : (show $ n - 1) ++ [char]
    | otherwise           = string
  helper n (char : chars) = helper (n + 1) chars
  in helper 0 string

main=interact$unlines.map f.tail.lines
l=length
f x|l x<10=x|1>0=(head x:show(l x))++[last x]

main=interact$unlines.map f.tail.lines
l=length
f x|l x<11=x|1>0=(head x:show(l x))++[last x]

convertStr contents = if (length contents) > 10 then print ([(contents !! 0)] ++ (show ((length contents) - 2)) ++ [(contents !! ((length contents) - 1))]) else print contents

outputI18 1 = do
    contents <- getLine
    convertStr contents
outputI18 n = do
    contents <- getLine
    convertStr contents
    outputI18 (n-1)

main = do
    input1 <- getLine
    let n = (read input1 :: Int)
    outputI18 n

module Main where

import Control.Arrow

main = do
  n:ws <- lines `fmap` getContents
  putStr $ ($ ws) $ take (read n) >>> map abbreviation >>> unlines
    where abbreviation w
            | length w > 10 = head w: show (length w) ++ [last w]
            | otherwise = w

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

abbrWord :: String -> String
abbrWord s
    | length s <= 10 = s
    | otherwise      = [head s] ++ show ((-) (length s) 2) ++ [last s]

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    print xs
    mapM_ putStrLn $ map abbrWord xs

import Control.Monad

shorten :: String -> String
shorten w | length w > 10 = [head w] ++ show (length w - 2) ++ [last w]
          | otherwise = "test"

main = do n <- fmap read getLine
          strings <- sequence $ take n (repeat getLine)
          forM_ strings (putStrLn . shorten)

main = do
  n <- fmap read getLine :: IO Int
  rep n solve

rep 0 x = return ()
rep n x = x >> rep (n-1) x

solve :: IO ()
solve = do
  cs <- getLine
  let l = length cs
  putStrLn $
    if l > 4
    then (head cs) : (show (l-2))++[(last cs)]
    else cs

main = do
  n <- fmap read getLine :: IO Int
  rep n solve

rep 0 x = return ()
rep n x = print n >> x >> rep (n-1) x

solve :: IO ()
solve = do
  cs <- getLine
  let l = length cs
  putStrLn $
    if l > 4
    then (head cs) : (show (l-2))++[(last cs)]
    else cs

module Main where

isTooLong word = length word > 10
lengthBetweenFirstAndLast word = length word - 2
solveCases remainingCases results = do
    word <- getLine
    let result = if isTooLong word then ([head word] ++ (show $ lengthBetweenFirstAndLast word) ++ [last word]) else word
    if remainingCases - 1 > 0 then solveCases (remainingCases - 1) (results ++ [result]) else return (results ++ [result])

main = do
    line <- getLine
    let caseCount = read line :: Int
    results <- solveCases caseCount []
    mapM print results

f w = let n = length w in if n<10 then w else [w!!0] ++ show (n-2) ++ [w!!(n-1)]

g _ = do
    w <- getLine
    print . f $ w

main = do
    n <- getLine
    mapM_  g [1..read$n]

f w = let n = length w in if n<10 then w else [w!!0] ++ show (n-2) ++ [w!!(n-1)]

g _ = do
    w <- getLine
    putStrLn . f $ w

main = do
    n <- getLine
    mapM_  g [1..read$n]

shorten s | length s < 10 = s
          | otherwise     = head s : show (length s - 2) ++ [last s]
main = interact $ unlines . map shorten . tail . lines

func [] = []
func str
     |(length str > 4) =
          let
               left = head str
               center = (show $ length $ tail $ init str)
               right = last str
          in  reverse ((:) right (reverse ((:) left center)))
     |otherwise = str
main :: IO()
main = do
   a <- getLine
   putStrLn $ func a

func x
     |((length x) < 10) = x
     |otherwise = (:) (head x) (reverse ((:) (last x) (reverse $ show ((length x) - 2))))
main :: IO()
main = do
     a <- getLine
     print $ func a

func [] = []
func str
     |(length str > 4) =
          let
               left = head str
               center = (show $ length $ tail $ init str)
               right = last str
          in  reverse ((:) right (reverse ((:) left center)))
     |otherwise = str

func2 :: Int -> IO()
func2 n =
     if n > 0
     then do
               str <- getLine
               putStrLn $ func str
               func2 (n - 1)
     else return ()
main :: IO()
main = do
   a <- getLine
   func2 (read a::Int)

import Control.Applicative
import Control.Monad

solve s = if len > 10 then concat [[f], show len, [l]] else s
	where	len = (length s) - 2
		l = last s
		(f:_) = s

main = do
	sn <- getLine
	let n = read sn :: Int
	forM [1..n]	(\_ -> do
				ln <- solve <$> getLine
				putStrLn $ ln
			)
	return ()

import Control.Applicative
import Control.Monad

solve s = if len > 10 then concat [[f], show len, [l]] else s
	where	len = (length s) - 2
		l = last s
		(f:_) = s

main = do
	sn <- getLine
	let n = read sn :: Int
	res <- forM [1..n]	(\_ -> do
					solve <$> getLine
				)
	mapM putStrLn res
	return ()

f s = if 10 < length s then
        [head s] ++ (show $ len s) ++ [last s]
      else
        s
  where len s = length $ init $ tail s

main = interact $ (++ "\n")
  . f
  . head . lines

import Control.Monad

main = do
    lines <- getLine
    let cases = read lines :: Int
    results <- forM [1..cases] (\_ -> do
        line <- getLine
        let result = solve line
        return result)
    mapM putStrLn results

solve :: String -> String
solve s
    | length s <= 4 = s
    | otherwise     = [head s] ++ (show (length s - 2)) ++ [last s]

main :: IO ()
main = do
    word <- getLine
    putStrLn $ compress word

compress :: String -> String
compress str
    | tooLong str   = first ++ len ++ final
    | otherwise       = str
    where first = [head str]
          len   = show $ length str - 2
          final = [last str]

tooLong :: String -> Bool
tooLong str = length str > 10

main :: IO ()
main = do
    n <- getInt
    ls <- getContents
    putStrLn $ (unlines . map compress . take n . lines) (tail ls)

compress :: String -> String
compress str
    | tooLong str   = first ++ len ++ final
    | otherwise       = str
    where first = [head str]
          len   = show $ length str - 2
          final = [last str]

tooLong :: String -> Bool
tooLong str = length str > 10

getInt :: IO Int
getInt = do
    n <- getLine
    return $ read n

import Control.Monad (replicateM)

charToString :: Char -> String
charToString ch = [ch]

createAbbreviation :: String -> String
createAbbreviation str =
    (charToString $ head str) ++ (show $ (length str - 2)) ++ (charToString $ last str)

processString :: String -> String
processString str
    | (length str) > 10 = createAbbreviation str
    | otherwise = str

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

processCount :: IO Int
processCount = fmap read getLine

processItems :: Int -> IO [String]
processItems n =
    getLines n >>= return . fmap processString

main :: IO ()
main = do
    count <- processCount
    items <- processItems count
    print items

import Control.Monad (replicateM)

charToString :: Char -> String
charToString ch = [ch]

createAbbreviation :: String -> String
createAbbreviation str =
    (charToString $ head str) ++ (show $ length str) ++ (charToString $ last str)

processString :: String -> String
processString str
    | (length str) > 10 = createAbbreviation str
    | otherwise = str

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

processCount :: IO Int
processCount = fmap read getLine

processItems :: Int -> IO [String]
processItems n =
    getLines n >>= return . fmap processString

main :: IO ()
main = do
    count <- processCount
    items <- processItems count
    print items

main = interact f
f s | length s > 10 = [head s] ++ show ( (length s) - 2 ) ++ [last s]
    | otherwise = s

shorten :: String -> String
shorten s
  | length s <= 10 = s
  | otherwise = [head s] ++ show (length s - 2) ++ [last s]

solve :: String -> String
solve input = unlines $ map shorten $ lines input

main :: IO ()
main = interact solve

module Main where

import Control.Monad (replicateM_)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumber :: IO Int
readNumber = (fromJust . fmap fst . BS.readInt) `fmap` BS.getLine

abbreviateWord :: BS.ByteString -> BS.ByteString
abbreviateWord w =
    BS.concat [ BS.pack [firstLetter]
              , BS.pack (show ((BS.length w) - 2))
              , BS.pack [lastLetter] ]
  where
    firstLetter = BS.head w
    lastLetter  = BS.head (BS.reverse w)

main :: IO ()
main = do
  nCases <- readNumber
  replicateM_ nCases $ do
    word <- BS.getLine
    BS.putStrLn (if (BS.length word) > 10
                 then abbreviateWord word
                 else word)

module Main where

import Control.Monad (replicateM_)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as BS

readNumber :: IO Int
readNumber = (fromJust . fmap fst . BS.readInt) `fmap` BS.getLine

abbreviateWord :: BS.ByteString -> BS.ByteString
abbreviateWord w =
    BS.concat [ firstLetter
              , BS.pack (show ((BS.length w) - 2))
              , lastLetter ]
  where
    firstLetter = BS.take 1 w
    lastLetter  = BS.take 1 (BS.reverse w)

main :: IO ()
main = do
  nCases <- readNumber
  replicateM_ nCases $ do
    word <- BS.getLine
    BS.putStrLn (if (BS.length word) > 10
                 then abbreviateWord word
                 else word)

get_and_parse = do s <- getLine
                   let len = length s
                   if len <= 10
                   then print s
                   else print ([(head s)] ++ (show (len-2)) ++ [(last s)])

work n = if n > 0
         then do get_and_parse
                 work (n-1)
         else return ()

main = do s <- getLine
          let num = read s :: Int
          work num

import Control.Monad (forM_)

main = (\x -> forM_ [1..x] $ const (((\ y -> if length y > 10 then head y:(show $ length y) ++ last y:[] else y) <$> getLine) >>= putStrLn)) =<< (readLn :: IO Int)

import Control.Applicative
import Control.Monad

onecase= do
		x<-getLine
		let s= length x
		if s <=10 then print s else print $ [(head x )] ++show(s-2) ++[(last x)]

main= do
	w<- read <$> getLine:: IO Int
	replicateM_ w onecase

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

text = [ "4"
       , "word"
       , "localization"
       , "internationalization"
       , "pneumonoultramicroscopicsilicovolcanoconiosis"
       ]

f text = [f] ++ show (len - 2) ++ [l]
    where
      len = length text
      f   = head text
      l   = last text

main = do { _:ts <- lines <$> getContents
          ; mapM_ (printf "%s\n") . map f $ ts
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

text = [ "4"
       , "word"
       , "localization"
       , "internationalization"
       , "pneumonoultramicroscopicsilicovolcanoconiosis"
       ]

f text = [f] ++ show (len - 2) ++ [l]
    where
      len = length text
      f   = head text
      l   = last text

main = do { t:ts <- lines <$> getContents
          ; mapM_ (printf "%s\n") . map f $ ts
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

f text = [f] ++ show (len - 2) ++ [l]
    where
      len = length text
      f   = head text
      l   = last text

main = do { t:ts <- lines <$> getContents
          ; print . map f $ ts
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

text = [ "4"
       , "word"
       , "localization"
       , "internationalization"
       , "pneumonoultramicroscopicsilicovolcanoconiosis"
       ]

f text = [f] ++ show (len - 2) ++ [l]
    where
      len = length text
      f   = head text
      l   = last text

main :: IO ()
main = do { _:ts <- lines <$> getContents
          ; mapM_ (printf "%s\n") . map f $ ts
          }

module Main where
import Control.Applicative
import Data.List
import Text.Printf
import Data.Time
import Data.Time.Calendar

main = do { ns <- lines <$> getContents
          ; print ns
          }

shorten :: String -> String
shorten x | length x > 10 = [head x] ++ (show $ length $ init $ tail x) ++ [last x]
          | otherwise     = x

main :: IO ()
main = do cont <- getContents
          mapM_ (putStrLn . shorten) $ lines cont

import Data.Char
import Data.List

ans str = if l<10 then str
               else [head str] ++ show (l-2) ++ [last str]
    where l = length str
main=do
    input<-getContents
    putStr.unlines $ map ans $tail.lines $ input

import Data.Char
import Data.List

ans str = if l<10 then str
               else [head str] ++ show l ++ [last str]
    where l = length str
main=do
    input<-getContents
    putStr.unlines $ map ans $tail.lines $ input


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Data.List

main = getLine >>= test.read
test 0 = return ()
test i = do
  n <- read <$> getLine
  let vs = solve n
  print $ length vs
  putStrLn $ unwords $ map show vs
  test (i - 1)

solve n = map head $ group $ sort $ as ++ bs where
  r = floor $ sqrt $ fromIntegral n
  as = [0..r]
  bs = map (div n) [1..r]

import Data.List
import Control.Monad

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- (readLn :: IO Int)
        let ans = sort $ f n in
            putStrLn $ (show . length $ ans) ++ "\n" ++
                (unwords . map show $ ans)

f :: Int -> [Int]
f x = 0 : c x 1

c :: Int -> Int -> [Int]
c x i
    | z > x = []
    | d == div x d = [d]
    | and [div x i == d, div x d == i] = i : d : (c x $ i + 1)
    | otherwise = c x $ i + 1
    where d = div x i
          z = i * i

--solve :: Int -> (Int,[Int])
import Data.List
import Control.Monad
--solve :: Int -> Int
solve x = (n,l3)
	where
		n = (if b then x2*2 else x2*2+1)
		x2 = (floor.sqrt.fromIntegral) x
		b = x2 ^2 +x2 > x
		l1=[0..x2]
		l2=map (\y -> x `div` y) (tail l1)
		l3 = if b then l1 ++ (tail $ reverse l2) else l1 ++ (reverse l2)

routine = do
	n <- readLn
	let (x,y)=solve n
	print x
	putStrLn $ unwords $ map show y

main= do
	n <- readLn
	replicateM_ n routine

import Data.List
import Control.Monad

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- (readLn :: IO Int)
        let ans = myNub . sort $ f n in
            putStrLn $ (show . length $ ans) ++ "\n" ++
                (unwords . map show $ ans)

f :: Int -> [Int]
f x = 0 : x : c x 1

c :: Int -> Int -> [Int]
c x i
    | z > x = []
    | z == x = [i]
    | and [div x i == d, div x d == i] = i : d : (c x $ i + 1)
    | otherwise = c x $ i + 1
    where d = div x i
          z = i * i

myNub :: [Int] -> [Int]
myNub [x] = [x]
myNub (x:y:xs)
    | x == y = myNub (y:xs)
    | otherwise = x : myNub (y:xs)

import Data.List
import Control.Monad

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- (readLn :: IO Int)
        let ans = sort $ f n in
            putStrLn $ (show . length $ ans) ++ "\n" ++
                (unwords . map show $ ans)

f :: Int -> [Int]
f x = 0 : c x 1

c :: Int -> Int -> [Int]
c x i
    | z > x = []
    | d == div x i = [i]
    | and [div x i == d, div x d == i] = i : d : (c x $ i + 1)
    | otherwise = c x $ i + 1
    where d = div x i
          z = i * i

import Data.List
import Control.Monad

getList :: (Read a) => IO [a]
getList = map read <$> words <$> getLine

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- (readLn :: IO Int)
        let ans = sort $ f n in
            putStrLn $ (show . length $ ans) ++ "\n" ++
                (unwords . map show $ ans)

f :: Int -> [Int]
f x = 0 : c x 1

c :: Int -> Int -> [Int]
c x i
    | z > x = []
    | z == x = [i]
    | and [div x i == d, div x d == i] = i : d : (c x $ i + 1)
    | otherwise = c x $ i + 1
    where d = div x i
          z = i * i


import Control.Monad
import Data.List
import Data.Ord

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [a, b] <- map read . words <$> getLine :: IO [Int]
        s <- getLine
        print $! solve a b s

trimZeros = f . f
          where f = dropWhile (=='0') . reverse

solve :: Int -> Int -> String -> Int
solve a b s = if o > 0 then minimum $ zipWith (+) [o, o-a..a] $ scanl (+) 0 z else 0
    where t = group $ trimZeros s
          o = a * (length $ filter ((=='1') . head) t)
          z = sort $ map ((b*). length) $ filter ((=='0') . head) t

{-# LANGUAGE ViewPatterns #-}

import Control.Arrow ((>>>))
import Data.List (dropWhileEnd, group)

main :: IO ()
main = interact $ words >>> drop 1 >>> process >>> map show >>> unlines

process :: [String] -> [Int]
process [] = []
process ((read -> a):(read -> b):xs:xss) = solve a b xs : process xss

solve :: Int -> Int -> String -> Int
solve a b = sum . map cost . group . dropWhile (== '0') . dropWhileEnd (== '0')
  where
    cost ys
      | head ys == '0' = min 0 $ b * length ys - a
      | otherwise = a

import Control.Monad
import Data.List
import Data.Ord

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [a, b] <- map read . words <$> getLine :: IO [Int]
        s <- getLine
        print $! solve a b $ trimZeros s

trimZeros = f . f
          where f = dropWhile (=='0') . reverse

solve :: Int -> Int -> String -> Int
solve _ _ [] = 0
solve a b s = minimum $ zipWith (+) [o, o-a..a] $ scanl (+) 0 z
    where t = group s
          o = a * (length $ filter ((=='1') . head) t)
          z = sort $ map ((b*). length) $ filter ((=='0') . head) t

import Control.Monad
import Data.List
import Data.Ord

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [a, b] <- map read . words <$> getLine :: IO [Int]
        s <- getLine
        print $! solve a b s

trimZeros = f . f
          where f = dropWhile (=='0') . reverse

solve :: Int -> Int -> String -> Int
solve a b s = foldl min 0 $ zipWith (+) [o, o-a..a] $ scanl (+) 0 z
    where t = group $ trimZeros s
          o = a * (length $ filter ((=='1') . head) t)
          z = sort $ map ((b*). length) $ filter ((=='0') . head) t


{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 (solve n) poi (replicateM (n - 1) $ liftM2 (,) poi poi) poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m0 es k0 x = (\(lt, eq, gt) -> sum lt + sum eq + sum gt) $ dfs (accumArray (flip (:)) [] (1, n) $ concatMap (\(a, b) -> [(a, b), (b, a)]) es) (\_ ->  (\(lt, eq, gt) -> (map ((k - 1) *) lt, 0:eq, map ((m - k) *) gt)) . foldl' (\(!lt, !eq, !gt) (clt, ceq, cgt) -> (combine x lt $ zipWith3 (((+) .) . (+)) clt ceq cgt, combine (x - 1) eq clt, combine x gt $ zipWith (+) clt cgt)) def)
  where
  def = let d = 1:replicate x 0 in (d, d, d)
  k = fromIntegral k0
  m = fromIntegral m0
  combine hi xs ys = map Mnum $ elems (accumArray (+) 0 (0, hi) [(i + j, getMnum $ x' * y) | (i, x') <- ix xs, (j, y) <- ix ys, i + j <= hi] :: UArray Int Int64)
    where ix = zip [0..]

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

mbase = 1000000007
newtype Mnum = Mnum { getMnum :: Int64 }
instance Show Mnum where
  show (Mnum x) = show x
instance Num Mnum where
  (Mnum a) + (Mnum b) = Mnum $ (a + b) `rem` mbase
  (Mnum a) * (Mnum b) = Mnum $ (a * b) `rem` mbase
  (Mnum a) - (Mnum b) = Mnum $ (a - b) `mod` mbase
  fromInteger = Mnum . fromInteger

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 (solve n) poi (replicateM (n - 1) $ liftM2 (,) poi poi) poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m0 es k0 x = (\(!lt, !eq, !gt) -> sum lt + sum eq + sum gt) $ dfs (accumArray (flip (:)) [] (1, n) $ concatMap (\(a, b) -> [(a, b), (b, a)]) es) (\_ ->  (\(!lt, !eq, !gt) -> (map ((k - 1) *) lt, 0:eq, map ((m - k) *) gt)) . foldl' (\(!lt, !eq, !gt) (!clt, !ceq, !cgt) -> (combine x lt $ zipWith3 (((+) .) . (+)) clt ceq cgt, combine (x - 1) eq clt, combine x gt $ zipWith (+) clt cgt)) def)
  where
  def = (d, d, d)
    where d = 1:replicate x 0
  k = Mnum $ fromIntegral k0
  m = Mnum $ fromIntegral m0
  combine hi xs ys = map Mnum $ elems (accumArray (+) 0 (0, hi) [(i + j, getMnum $ x' * y) | (i, x') <- ix xs, (j, y) <- ix ys, i + j <= hi] :: UArray Int Int64)
    where ix = zip [0..]

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

mbase = 1000000007
newtype Mnum = Mnum { getMnum :: Int64}
instance Show Mnum where
  show (Mnum x) = show x
instance Num Mnum where
  (Mnum a) + (Mnum b) = Mnum $ (a + b) `rem` mbase
  (Mnum a) * (Mnum b) = Mnum $ (a * b) `rem` mbase
  (Mnum a) - (Mnum b) = Mnum $ (a - b) `mod` mbase
  fromInteger = Mnum . fromInteger

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 (solve n) poi (replicateM (n - 1) $ liftM2 (,) poi poi) poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m0 es k0 x = (\(lt, eq, gt) -> sum lt + sum eq + sum gt) $ dfs (accumArray (flip (:)) [] (1, n) $ concatMap (\(a, b) -> [(a, b), (b, a)]) es) (\_ ->  (\(!lt, !eq, !gt) -> (map ((k - 1) *) lt, 0:eq, map ((m - k) *) gt)) . foldl' (\(!lt, !eq, !gt) (clt, ceq, cgt) -> (combine x lt $ zipWith3 (((+) .) . (+)) clt ceq cgt, combine (x - 1) eq clt, combine x gt $ zipWith (+) clt cgt)) def)
  where
  def = let d = 1:replicate x 0 in (d, d, d)
  k = fromIntegral k0
  m = fromIntegral m0
  combine hi xs ys = map Mnum $ elems (accumArray (+) 0 (0, hi) [(i + j, getMnum $ x' * y) | (i, x') <- ix xs, (j, y) <- ix ys, i + j <= hi] :: UArray Int Int64)
    where ix = zip [0..]

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

mbase = 1000000007
newtype Mnum = Mnum { getMnum :: Int64 }
instance Show Mnum where
  show (Mnum x) = show x
instance Num Mnum where
  (Mnum a) + (Mnum b) = Mnum $ (a + b) `rem` mbase
  (Mnum a) * (Mnum b) = Mnum $ (a * b) `rem` mbase
  (Mnum a) - (Mnum b) = Mnum $ (a - b) `mod` mbase
  fromInteger = Mnum . fromInteger

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  show `fmap` liftM4 (solve n) poi (replicateM (n - 1) $ liftM2 (,) poi poi) poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m0 es k0 x = (\(!lt, !eq, !gt) -> sum lt + sum eq + sum gt) $ dfs (accumArray (flip (:)) [] (1, n) $ concatMap (\(a, b) -> [(a, b), (b, a)]) es) (\_ ->  (\(!lt, !eq, !gt) -> (map ((k - 1) *) lt, 0:eq, map ((m - k) *) gt)) . foldl' (\(!lt, !eq, !gt) (!clt, !ceq, !cgt) -> (combine lt $ zipWith3 (((+) .) . (+)) clt ceq cgt, combine eq clt, combine gt $ zipWith (+) clt cgt)) def)
  where
  def = (d, d, d)
    where d = 1:replicate x 0
  k = Mnum $ fromIntegral k0
  m = Mnum $ fromIntegral m0
  combine xs ys = map Mnum $ elems (accumArray (+) 0 (0, x) [(i + j, getMnum $ x' * y) | (i, x') <- ix xs, (j, y) <- ix ys, i + j <= x] :: UArray Int Int64)
    where ix = zip [0..]

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

mbase = 1000000007
newtype Mnum = Mnum { getMnum :: Int64}
instance Show Mnum where
  show (Mnum x) = show x
instance Num Mnum where
  (Mnum a) + (Mnum b) = Mnum $ (a + b) `rem` mbase
  (Mnum a) * (Mnum b) = Mnum $ (a * b) `rem` mbase
  (Mnum a) - (Mnum b) = Mnum $ (a - b) `mod` mbase
  fromInteger = Mnum . fromInteger


{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Int
import Data.Maybe
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    (_,_k) <- readIntPair
    let k = fromIntegral _k
    as <- map fromIntegral <$> readInts
    let f x = x * k
        g x = if mod x k == 0 then x `div` k else 2000000000
        go :: (Integer -> Integer) -> M.Map Integer Integer -> [Integer] -> [Integer]
        go _ _ [] = []
        go h m (ra:ras) = v : go h m' ras
          where !v  = M.findWithDefault 0 (h ra) m
                m'  = M.insertWith (+) ra 1 m
    let bs1 = reverse $ go f M.empty (reverse as)
        bs2 = go g M.empty as
    print $ sum $ zipWith (*) bs1 bs2

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readIntPair :: IO (Int,Int)
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, findWithDefault, adjust, fromList, (!))

solve :: Int64 -> [Int64] -> Int64
solve 1 a = sum $ foldr loop (`seq` []) a init
    where
    init = fromList . zip a . repeat $ 0
    loop x f cnt = inc: f (adjust (+1) x cnt)
        where
        inc = val * (val - 1) `div` 2
        val = cnt ! x

solve k a = sum $ foldr loop (`seq` []) a (init, init)
    where
    init = fromList . zip a . repeat $ 0

    loop x go (cnt, obs)
        | rem /= 0  =   0: go (cnt', obs)
        | otherwise = val: go (cnt', adjust (+ inc) x obs)
        where
        (y, rem) = x `divMod` k
        cnt' = adjust (+1) x cnt
        inc = findWithDefault 0 y cnt
        val = findWithDefault 0 y obs

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = do
    [_, k] <- fmap fromIntegral . parse <$> B.getLine
    a <- fmap fromIntegral . parse <$> B.getLine
    print $ solve k a

import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Map (Map, findWithDefault, adjust, fromList, (!))

solve :: Int64 -> [Int64] -> Int64
solve 1 a = foldr loop (`seq` 0) a init
    where
    init = fromList . zip a . repeat $ 0
    loop x f cnt = inc + f (adjust (+1) x cnt)
        where
        inc = val * (val - 1) `div` 2
        val = cnt ! x

solve k a = foldr loop (`seq` 0) a (init, init)
    where
    init = fromList . zip a . repeat $ 0

    loop x go (cnt, obs)
        | rem /= 0  = go (cnt', obs)
        | otherwise = val + go (cnt', adjust (+ inc) x obs)
        where
        (y, rem) = x `divMod` k
        cnt' = adjust (+1) x cnt
        inc = findWithDefault 0 y cnt
        val = findWithDefault 0 y obs

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = do
    [_, k] <- fmap fromIntegral . parse <$> B.getLine
    a <- fmap fromIntegral . parse <$> B.getLine
    print $ solve k a

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    (_,_k) <- readIntPair
    let k = fromIntegral _k
    as <- map fromIntegral <$> readInts
    let f x = return $ x * k
        g x = guard (mod x k == 0) >> return (div x k)
        go :: (Integer -> Maybe Integer) -> M.Map Integer Integer -> [Integer] -> [Integer]
        go _ _ [] = []
        go h m (ra:ras) = v : go h m' ras
          where !v  = fromMaybe 0 $ h ra >>= flip M.lookup m
                m'  = M.insertWith (+) ra 1 m
    let bs1 = reverse $ go f M.empty (reverse as)
        bs2 = go g M.empty as
    print $ sum $ zipWith (*) bs1 bs2

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readIntPair :: IO (Int,Int)
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

data State = State (M.Map Int64 Int64) (M.Map Int64 Int64) !Int64
solve :: [Int64] -> Int64 -> State -> State
solve []    _  s = s
solve (i:t) k (State c g r) = solve t k (State nc ng nr)
  where
    nc = M.insertWith (+) i 1 c
    ng = fromMaybe g $ do
            guard (i `mod` k == 0)
            v <- M.lookup (div i k) c
            return $ M.insertWith (+) (i*k) v g
    nr = r + M.findWithDefault 0 i g

solveAux :: [Int64] -> Int64 -> Int64
solveAux a k = let State _ _ r = solve a k (State M.empty M.empty 0) in r

main :: IO ()
main = do
  [n,k] <- readInts
  a     <- readInts
  print $ solveAux a k

-- IO
readInt :: B.ByteString -> Int64
readInt = fromIntegral . fromJust . fmap fst . B.readInt
readInts :: IO [Int64]
readInts = map readInt . B.words <$> B.getLine

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

solve :: [Int64] -> Int64 -> M.Map Int64 Int64 -> M.Map Int64 Int64 -> Int64 -> Int64
solve []    _  _  _  r    = r
solve (i:t) k !c !g !r = solve t k nc ng nr
  where
    nc = M.insertWith (+) i 1 c
    ng = fromMaybe g $ do
            guard (i `mod` k == 0)
            v <- M.lookup (div i k) c
            return $ M.insertWith (+) (i*k) v g
    nr = r + M.findWithDefault 0 i g

solveAux :: [Int64] -> Int64 -> Int64
solveAux a k = solve a k M.empty M.empty 0

main :: IO ()
main = do
  [n,k] <- readInts
  a     <- readInts
  print $ solveAux a k

-- IO
readInt :: B.ByteString -> Int64
readInt = fromIntegral . fromJust . fmap fst . B.readInt
readInts :: IO [Int64]
readInts = map readInt . B.words <$> B.getLine

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

data State = State (M.Map Int64 Int64) (M.Map Int64 Int64) !Int64
solve :: [Int64] -> Int64 -> M.Map Int64 Int64 -> M.Map Int64 Int64 -> Int64 -> Int64
solve []    _  _  _  r = r
solve (i:t) k c g !r = solve t k nc ng nr
  where
    nc = M.insertWith (+) i 1 c
    ng = fromMaybe g $ do
            guard (i `mod` k == 0)
            v <- M.lookup (div i k) c
            return $ M.insertWith (+) (i*k) v g
    nr = r + M.findWithDefault 0 i g

solveAux :: [Int64] -> Int64 -> Int64
solveAux a k = solve a k M.empty M.empty 0

main :: IO ()
main = do
  [n,k] <- readInts
  a     <- readInts
  print $ solveAux a k

-- IO
readInt :: B.ByteString -> Int64
readInt = fromIntegral . fromJust . fmap fst . B.readInt
readInts :: IO [Int64]
readInts = map readInt . B.words <$> B.getLine

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.Base
import Data.Function(on)
import Data.Tuple(swap)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    (n,k) <- readIntPair
    as <- readInts
    let f x = let v = fromIntegral x * fromIntegral k  :: Int64 in
              if abs v <= 10^(9 :: Int) then
                  fromIntegral v
              else
                  maxBound
    let g x = if mod x k == 0 then x `div` k else maxBound
    let go :: (Int -> Int) -> M.Map Int Int -> [Int] -> [Int]
        go _ _ [] = []
        go h m (ra:ras) = v : go h m' ras
          where !v  = M.findWithDefault 0 (h ra) m
                m' = M.insertWith (+) ra 1 m
    let bs1 = reverse $ go f M.empty (reverse as)
        bs2 = go g M.empty as
    print $ sum $ zipWith (\a b ->
        fromIntegral a * fromIntegral b :: Integer) bs1 bs2

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readIntPair :: IO (Int,Int)
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"
p2l :: (a,a) -> [a]
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
inf :: Int
inf = maxBound `div` 2

-- Monad
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i0 judge incr step = sub i0 where
    sub i | judge i = step i >> sub (incr i)
          | otherwise = return ()
rep_ :: Monad m => Int -> (Int -> m ()) -> m ()
rep_ n = stepM_ 0 (<n) (+1)
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
memoize :: (Monad m) => (k -> m (Maybe v)) -> (k -> v -> m ()) -> k -> m v -> m v
memoize getter setter key action = do
    mv <- getter key
    case mv of
        Just v -> return v
        Nothing -> action >>= thru (setter key)

-- Array
newUArray :: (MArray (STUArray s) e (ST s),Ix i) =>
             (i,i) -> e -> ST s (STUArray s i e)
newUArray = newArray
newBArray :: (Ix i) => (i,i) -> e -> ST s (STArray s i e)
newBArray = newArray
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
fromEdges :: Ix i => (i,i) -> [(i,e)] -> Array i [e]
fromEdges = accumArray (flip (:)) []

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Data.Int
import Control.Applicative
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Map.Strict as M

data State = State !(M.Map Int64 Int64) !(M.Map Int64 Int64) !Int64
     deriving (Show)

solveAux :: [Int64] -> Int64 -> Int64
solveAux a k = case solve a (State M.empty M.empty 0) of State _ _ r -> r
  where
    solve :: [Int64] -> State -> State
    solve []    s             = s
    solve (i:t) (State c g r) = solve t (State nc ng nr)
      where
        nc = M.insertWith (+) i 1 c
        ng = fromMaybe g $ do
          guard $ i `mod` k == 0
          v <- M.lookup (i `div` k) c
          return $ M.insertWith (+) (i*k) v g
        nr = r + (M.findWithDefault 0 i g)

main :: IO ()
main = do
  -- [n,k] <- (map read . words) <$> getLine
  -- a     <- (map read . words) <$> getLine
  [n,k] <- readInts
  a     <- readInts
  print $ solveAux a k

readInt :: B.ByteString -> Int64
readInt = fromIntegral . fromJust . fmap fst . B.readInt

readInts :: IO [Int64]
readInts = map readInt . B.words <$> B.getLine

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Data.Int
import Control.Applicative
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.Map.Strict as M

data State = State !(M.Map Int64 Int64) !(M.Map Int64 Int64) !Int64
     deriving (Show)

solveAux :: [Int64] -> Int64 -> Int64
solveAux a k = case solve a (State M.empty M.empty 0) of State _ _ r -> r
  where
    solve :: [Int64] -> State -> State
    solve []    s             = s
    solve (i:t) (State c g r) = solve t (State nc ng nr)
      where
        nc = M.insertWith (+) i 1 c
        ng = if i `mod` k == 0 then
               M.insertWith (+) (i*k) (M.findWithDefault 0 (i `div` k) c) g
             else
               g
        nr = r + (M.findWithDefault 0 i g)

main :: IO ()
main = do
  -- [n,k] <- (map read . words) <$> getLine
  -- a     <- (map read . words) <$> getLine
  [n,k] <- readInts
  a     <- readInts
  print $ solveAux a k

readInt :: B.ByteString -> Int64
readInt = fromIntegral . fromJust . fmap fst . B.readInt

readInts :: IO [Int64]
readInts = map readInt . B.words <$> B.getLine

#!/usr/bin/env stack
-- stack --resolver=lts-2.21 --install-ghc runghc

import Control.Applicative
import qualified Data.Map.Strict as M
data State = State (M.Map Int Int) (M.Map Int Int) Int
     deriving (Show)

solve :: [Int] -> Int -> State -> State
solve []    _ s             = s
solve (i:t) k (State c g r) = solve t k (State nc ng nr)
  where
    nc = M.insert i ((M.findWithDefault 0 i c) + 1) c
    ng = if i `mod` k == 0 then
           M.insert (i*k) ((M.findWithDefault 0 (i*k) g) + (M.findWithDefault 0 (i `div` k) c)) g
         else
           g
    nr = r + (M.findWithDefault 0 i g)

solveAux :: [Int] -> Int -> Int
solveAux a k =
  case solve a k (State M.empty M.empty 0) of State _ _ r -> r

main :: IO ()
main = do
  [n,k] <- (map read . words) <$> getLine
  a     <- (map read . words) <$> getLine
  let r =  solveAux a k
  print r


import Control.Monad (replicateM)
import Data.Bits ((.|.))
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as C

main = do
  [n] <- getArray
  a <- replicateM n $ getArray
  putStrLn $ unwords $ map show $ map (foldr (.|.) 0 . filter (>=0)) a
  where
    getArray = fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine

import Data.Bits
main=interact$unwords.map(show.f.map read.words).tail.lines
f :: [Int] -> Int
f xs = foldl(.|.)0$filter(>=0)xs


import Data.Bits

z = 2^19

solve :: Int -> Int -> Maybe [Int]
solve 1 x = Just [x]
solve 2 0 = Nothing
solve 2 x = Just $ [1, x `xor` 1]
solve n x
   | v >= n    = Just $ v : [1..(n-1)]
   | v == 1    = Just $ (v .|. z) : 1 : (2 .|. z) : [3..(n-1)]
   | otherwise = Just $ (v .|. z) : (1 .|. z) : [2..(n-1)]
  where v = foldl xor x [1..(n-1)]

main = do
  [n, x] <- fmap (map read . words) getLine
  case solve n x of
    Nothing -> putStrLn "NO"
    Just xs -> putStrLn "YES" >> putStrLn (unwords . map show $ xs)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && n == 2 = Nothing
  | n == 1 = Just [x]
  | n == 2 = Just [x, 0]
  | otherwise = Just $ ([262144, 393216] ++) $ (:) =<< (xor 131072 . foldl' xor x) $ take (n - 3) [1..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && n > 1 = Nothing
  | odd n = Just $ (:) =<< foldl' xor x $ take (n - 1) [2^17..]
  | otherwise = Just $ (0:) $ (:) =<< foldl' xor x $ take (n - 2) [2^17..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | odd n = Just $ go n (2^17) x
  | otherwise = Just $ (++) =<< (go 3 (2^18) . foldl' xor x) $ take (n - 3) [2^17..]

go n lo x = (:) =<< foldl' xor x $ take (n - 1) [lo..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Array.Unboxed
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x = (:) =<< foldl' xor x $ take (n - 1) [10^5+1..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | odd n = Just $ (:) =<< foldl' xor x $ take (n - 1) [2^17..]
  | otherwise = Just $ (0:) $ (:) =<< foldl' xor x $ take (n - 2) [2^17..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | odd n = Just $ go n (2^17) x
  | otherwise = Just $ (++) =<< (go 3 (2^19) . foldl' xor x) $ take (n - 3) [2^17..]

go n lo x = (:) =<< foldl' xor x $ take (n - 1) [lo..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | otherwise = Just $ ([262144, 393216] ++) $ (:) =<< (xor 131072 . foldl' xor x) $ take (n - 3) [1..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | odd n = Just $ (:) =<< foldl' xor x $ take (n - 1) [2^17..] -- 0....
  | otherwise = Just $ ([0, 2^17]++) $ (:) =<< (flip clearBit 17 . foldl' xor x) $ take (n - 3) [2^17 + 1..] --1......

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | odd n = (:) =<< foldl' xor x $ take (n - 1) [2^17..]
  | otherwise = (0:) $ (:) =<< foldl' xor x $ take (n - 2) [2^17..]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bits
import Data.List

main = putStr . evalState app . B.words =<< B.getContents

app = maybe "NO" (("YES\n" ++) . unwords . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n x
  | x == 0 && even n = Nothing
  | n == 1 = Just [x]
  | n == 2 = Just [x, 0]
  | otherwise = Just $ ([262144, 393216] ++) $ (:) =<< (xor 131072 . foldl' xor x) $ take (n - 3) [1..]

import Data.Bits

z = 2^19

solve :: Int -> Int -> Maybe [Int]
solve 2 0 = Nothing
solve 2 x = Just $ [1, x `xor` 1]
solve n x
   | v >= n    = Just $ v : [1..(n-1)]
   | v == 1    = Just $ (v .|. z) : 1 : (2 .|. z) : [3..(n-1)]
   | otherwise = Just $ (v .|. z) : (1 .|. z) : [2..(n-1)]
  where v = foldl xor x [1..(n-1)]

main = do
  [n, x] <- fmap (map read . words) getLine
  case solve n x of
    Nothing -> putStrLn "NO"
    Just xs -> putStrLn "YES" >> putStrLn (unwords . map show $ xs)

import Data.Bits

z = 2^19

solve :: Int -> Int -> Maybe [Int]
solve 2 0 = Nothing
solve n x
   | v >= n    = Just $ v : [1..(n-1)]
   | v == 1    = Just $ (v .|. z) : 1 : (2 .|. z) : [3..(n-1)]
   | otherwise = Just $ (v .|. z) : (1 .|. z) : [2..(n-1)]
  where v = foldl xor x [1..(n-1)]

main = do
  [n, x] <- fmap (map read . words) getLine
  case solve n x of
    Nothing -> putStrLn "NO"
    Just xs -> putStrLn "YES" >> putStrLn (unwords . map show $ xs)


import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> drop 1 -- t
      >>> map (words >>> map read)
      >>> process
      >>> map (map show >>> unwords)
      >>> unlines

process :: [[Int]] -> [[Int]]
process [] = []
process ([_, t] : a : rest) = solve t a : process rest

solve :: Int -> [Int] -> [Int]
solve t a =
  fst $
    foldr
      ( \x (ans, col) ->
          case compare t (2 * x) of
            EQ -> (col:ans, 1 - col)
            LT -> (0:ans, col)
            GT -> (1:ans, col)
      )
      ([], 0)
      a

import Control.Monad
import Data.Bool

solve :: Int -> [Int] -> [Bool]
solve u a = let
  ct = length [() | x <- a, x + x == u]
  go 0 [] = []
  go 0 (s : t) = (s + s <= u) : go 0 t
  go k (s : t) = case  compare (s + s) u  of
    LT -> True : go k t
    EQ -> False : go (k - 1) t
    GT -> False : go k t
  go _ _ = error "..."
  in  go (div ct 2) a

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [_n, u] <- map read . words <$> getLine
    a <- map read . words <$> getLine
    putStrLn . unwords . map (bool "0" "1") $ solve u a


import Control.Monad
import Data.List

solve :: [(Int, Int)] -> String -> Maybe String
solve [_] acc = Just acc
solve ((x1,y1):(x2,y2):xs) acc
  | x1 <= x2 && y1 <= y2 = solve ((x2,y2):xs) (acc ++ path)
  | otherwise = Nothing
  where
    path = (replicate (x2-x1) 'R') ++ replicate (y2-y1) 'U'

main = do
  t <- readLn :: IO Int
  replicateM_ t $ do
    n <- readLn :: IO Int
    xys <- replicateM n $ do
      [a,b] <- map read . words <$> getLine :: IO [Int]
      return (a,b)
    case solve ((0,0):(sort xys)) "" of
      Just res -> do
        putStrLn "YES"
        putStrLn res
      Nothing -> do
        putStrLn "NO"

import Data.Char
import Data.List
import Control.Monad

checkYs :: [Int] -> Bool
checkYs ys = -1 == (foldr (\a b -> if a <= b then a else -1) 1001) ys

isImpossible :: Int -> [(Int, Int)] -> Bool
isImpossible n = checkYs . map snd

getPath :: (Int, Int) -> Int -> [(Int, Int)] -> String
getPath _ 0 _                     = []
getPath (x1, y1) n ((x2, y2):xys) = (rs) ++ (us) ++ (getPath (x2, y2) (n - 1) xys)
    where rTimes = x2 - x1
          uTimes = y2 - y1
          rs     = replicate rTimes 'R'
          us     = replicate uTimes 'U'

solve :: Int -> [(Int, Int)] -> String
solve n xy
    | invalid   = "NO"
    | otherwise = "YES\n" ++ (getPath (0, 0) n xys)
    where xys     = sort xy
          invalid = isImpossible n xys

makePair :: String -> (Int, Int)
makePair s = (a, b)
    where wds = words s
          a = read (wds !! 0)
          b = read (wds !! 1)

testCase :: IO ()
testCase = do
    n <- read <$> getLine
    inputs <- replicateM n (makePair <$> getLine)
    putStrLn $ solve n inputs

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM t testCase
    return ()

import Control.Monad
import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class

import Text.Read (readMaybe)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

get :: Read a => MaybeT IO a
get = MaybeT $ liftM readMaybe getToken

puts :: String -> MaybeT IO ()
puts = lift . putStr

putsln :: String -> MaybeT IO ()
putsln = lift . putStrLn

put :: Show a => a -> MaybeT IO ()
put = putsln . show

putln :: Show a => a -> MaybeT IO ()
putln = putsln . show

main :: IO ()
main = do
    o <- runMaybeT sub
    return ()

sub :: MaybeT IO ()
sub = do
    t <- get :: MaybeT IO Int
    replicateM_ t f1

f1 :: MaybeT IO ()
f1 = do { n <- get :: MaybeT IO Int
        ; a <- replicateM n $ liftM2 (,) get get :: MaybeT IO [(Int, Int)]
        ; case f2 a of
            Just s -> do
                putsln "YES"
                putsln s
            Nothing -> putsln "NO" }

f2 :: [(Int, Int)] -> Maybe String
f2 a =  let aux (a, b) (c, d) = case compare a c of
                                    EQ -> compare b d
                                    x -> x
        in toList <$> (f3 (0, 0) $ sortBy aux a)

f3 :: (Int, Int) -> [(Int, Int)] -> Maybe (Seq Char)
f3 _ [] = Just DSeq.Empty
f3 (a, b) ((c, d) : l) = if b > d then Nothing else
    (\x -> (DSeq.replicate (c - a) 'R' >< DSeq.replicate (d - b) 'U') >< x ) <$> f3 (c, d) l

import Control.Monad
import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Text.Read (readMaybe)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

get :: Read a => IO (Maybe a)
get = liftM readMaybe getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

try :: Maybe (IO ()) -> IO ()
try = fromMaybe . return $ ()

main :: IO ()
main = do {
      t' <- get :: IO (Maybe Int)
    ; try $ do {
      t <- t'
    ; Just $ do {
      replicateM_ t f1 }}}

f1 :: IO ()
f1 = do { n' <- get :: IO (Maybe Int)
        ; try $ do {
          n <- n'
        ; Just $ do {
          a' <- replicateM n $ liftM2 (,) get get :: IO [(Maybe Int, Maybe Int)]
        ; try $ do {
          a <- toList <$> foldl (liftM2 (|>)) (Just DSeq.Empty) ((\ (x, y) -> liftM2 (,) x y) <$> a')
        ; Just $ case f2 a of
            Just s -> do
                putStrLn "YES"
                putStrLn s
            Nothing -> putStrLn "NO" }}}}

f2 :: [(Int, Int)] -> Maybe String
f2 a =  let aux (a, b) (c, d) = case compare a c of
                                    EQ -> compare b d
                                    x -> x
        in toList <$> (f3 (0, 0) $ sortBy aux a)

f3 :: (Int, Int) -> [(Int, Int)] -> Maybe (Seq Char)
f3 _ [] = Just DSeq.Empty
f3 (a, b) ((c, d) : l) = if b > d then Nothing else
    (\x -> (DSeq.replicate (c - a) 'R' >< DSeq.replicate (d - b) 'U') >< x ) <$> f3 (c, d) l

import Control.Monad
import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

get :: Read a => IO a
get = liftM read getToken

put :: Show a => a -> IO ()
put = putStr . show

putln :: Show a => a -> IO ()
putln = putStrLn . show

main :: IO ()
main = do
    t <- get :: IO Int
    replicateM_ t f1

f1 :: IO ()
f1 = do
    n <- get :: IO Int
    a <- replicateM n $ liftM2 (,) get get :: IO [(Int, Int)]
    case f2 a of
        Just s -> do
            putStrLn "YES"
            putStrLn s
        Nothing -> putStrLn "NO"

f2 :: [(Int, Int)] -> Maybe String
f2 a =  let aux (a, b) (c, d) = case compare a c of
                                    EQ -> compare b d
                                    x -> x
        in toList <$> (f3 (0, 0) $ sortBy aux a)

f3 :: (Int, Int) -> [(Int, Int)] -> Maybe (Seq Char)
f3 _ [] = Just DSeq.Empty
f3 (a, b) ((c, d) : l) = if b > d then Nothing else
    (\x -> (DSeq.replicate (c - a) 'R' >< DSeq.replicate (d - b) 'U') >< x ) <$> f3 (c, d) l