import Data.List (find,nub)
import Data.Char (isAlpha)

data Token = Word String | Blank | HypWord String deriving (Eq,Show)

-- Part 1 --

str2line :: String -> [Token]
str2line str = map Word $ words str

-- Part 2 --

tok2str :: Token -> String
tok2str Blank = " "
tok2str (Word w) = w
tok2str (HypWord w) = w ++ "-"

line2str :: [Token] -> String
line2str ln = unwords $ map tok2str ln

-- Part 3 --

tokLen :: Token -> Int
tokLen t = length $ tok2str t

-- Part 4 --

lineLen :: [Token] -> Int
lineLen ln = length $ line2str ln

-- Part 5 --

breakLine :: Int -> [Token] -> ([Token],[Token])
breakLine _ [] = ([], [])
breakLine len (t:ts)
  | len >= tokLen t =
      let (x,y) = breakLine (len-(tokLen t)-1) ts in
      (t:x,y)
  | otherwise = ([], t:ts)

-- Part 6 --

mergers :: [String] -> [(String,String)]
mergers (s1:s2:ss) = (s1,concat (s2:ss)):mergers ((s1++s2):ss)
mergers _ = []

-- Part 7 --

hyphenate :: [(String, [String])] -> Token -> [(Token,Token)]
hyphenate hyp (Word w) =
  let (wd,punct) = span isAlpha w in
  case find ((==wd).fst) hyp of
    Just (_,y) -> map (\(a,b)->(HypWord a, Word (b++punct))) $ mergers y
    Nothing -> []
hyphenate _ _ = []

-- Part 8 --

lineBreaks :: [(String, [String])] -> Int -> [Token] -> [([Token],[Token])]
lineBreaks hyp len line =
  case breakLine len line of
    (left,[]) -> [(left,[])]
    (left,tok:right) -> (left,tok:right) :
      (map (\(a,b)->(left++[a],b:right))
        $ filter (\(x,_)->lineLen left+(tokLen x) < len)
        $ hyphenate hyp tok)

-- Part 9 --

insertions :: a -> [a] -> [[a]]
insertions w l = [take i l ++ w:(drop i l) | i <- [0..length l]]

-- Part 10 --

insertBlanks :: Int -> [Token] -> [[Token]]
insertBlanks c ln =
  nub
  $ filter (\x->head x/=Blank && last x/=Blank)
  $ iterate (\x->concat (map (insertions Blank) x)) [ln] !! c

-- Part 11 --

blankDistances :: [Token] -> [Int]
blankDistances ln =
  case blankDistances' ln of
    [x] -> []
    x -> x
  where
    blankDistances' ln =
      case span (/=Blank) ln of
        (a,[]) -> [length a]
        (a,_:bs) -> (length a):(blankDistances' bs)

-- Part 12 --

avg :: [Double] -> Double
avg [] = 0
avg list = sum list / (fromIntegral (length list))

var :: [Double] -> Double
var list = avg $ map ((**2).(avg list-)) list

-- Part 13 --

data Costs =  Costs Double Double Double Double deriving (Eq,Show)

lineBadness :: Costs -> [Token] -> Double
lineBadness (Costs blankCost blankProxCost blankUnevenCost hypCost) ln =
  let blankDists = map fromIntegral $ blankDistances ln
      blankCount = (fromIntegral.length.filter (==Blank)) ln in
  blankCost * blankCount +
  if blankDists == [] then 0 else
    blankProxCost * (fromIntegral (length ln) - (avg blankDists))
  + blankUnevenCost * (var blankDists) +
  case last ln of
    (HypWord _) -> hypCost
    otherwise -> 0

-- Part 14 --

bestLineBreak :: Costs -> [(String, [String])] -> Int -> [Token] -> Maybe ([Token],[Token])
bestLineBreak costs hyp len line =
  let breaks = lineBreaks hyp len line
      insertEnoughBlanks ln = insertBlanks (len-(lineLen ln)) ln
      insertBlanksAndMakeTuples (ln,rest) = map (\ln'->(ln',rest)) $ insertEnoughBlanks ln
      withBlanks = concat $ map insertBlanksAndMakeTuples breaks
      cand = map (\(x,y)->(lineBadness costs x,(x,y))) withBlanks
      bestCost = minimum $ map fst cand in
  case filter ((==bestCost).fst) cand of
    [] -> Nothing
    ((_,z):_) -> Just z

-- Part 15 --

justifyLine :: Costs -> [(String, [String])] -> Int -> [Token] -> [[Token]]
justifyLine costs hyp len ln =
  case bestLineBreak costs hyp len ln of
    Nothing -> [ln]
    Just (l,ls) -> l:(justifyLine costs hyp len ls)

justifyText :: Costs  -> [(String, [String])] -> Int -> String -> [String]
justifyText costs hyp len text =
  map line2str
  $ justifyLine costs hyp len
  $ str2line text

--TESTS--
text :: String
text = "He who controls the past controls the future. He who controls the present controls the past."

defaultCosts :: Costs
defaultCosts = Costs 1 1 0.5 0.5

enHyp :: [(String, [String])]
enHyp = [("controls",["co","nt","ro","ls"]), ("future",["fu","tu","re"]),("present",["pre","se","nt"])]

tests :: [[(String,String)]]
tests = [
    [(show $ str2line text, show [Word "He",Word "who", Word "controls", Word "the", Word "past", Word "controls", Word "the", Word "future.", Word "He", Word "who", Word "controls", Word "the", Word "present", Word "controls", Word "the", Word "past."])]
  , [
    (line2str (str2line text), text)
    ,(line2str [Word "He",Word "who",HypWord "cont",Word "rols"], "He who cont- rols")
    ]
  , [
    (show $ tokLen (Word "He"), "2")
    ,(show $ tokLen (HypWord "cont"), "5")
    ,(show $ tokLen (Blank), "1")
    ]
  , [
    (show $ lineLen [Word "He",Word "who",Word "controls"], "15")
    ,(show $ lineLen [Word "He",Word "who",HypWord "con"], "11")
    ,(show $ lineLen [], "0")
    ]
  , [
    (show $ breakLine 1 [Word "He",Word "who",Word "controls"], show ([]::[Token],[Word "He",Word "who",Word "controls"]))
    ,(show $ breakLine 2 [Word "He",Word "who",Word "controls"], show ([Word "He"],[Word "who",Word "controls"]))
    ,(show $ breakLine 5 [Word "He",Word "who",Word "controls"], show ([Word "He"],[Word "who",Word "controls"]))
    ,(show $ breakLine 6 [Word "He",Word "who",Word "controls"], show ([Word "He",Word "who"],[Word "controls"]))
    ,(show $ breakLine 100 [Word "He",Word "who",Word "controls"], show ([Word "He",Word "who",Word "controls"],[]::[Token]))
    ,(show $ breakLine 0 [], show ([]::[Token],[]::[Token]))
    ]
  , [
    (show $ mergers ["co","nt","ro","ls"], show [("co","ntrols"),("cont","rols"),("contro","ls")])
    ,(show $ mergers ["co","nt"], show [("co","nt")])
    ,(show $ mergers ["co"], "[]")
    ]
  , [
    (show $ hyphenate enHyp (Word "controls"), show [(HypWord "co",Word "ntrols"),(HypWord "cont",Word "rols"),(HypWord "contro",Word "ls")])
    ,(show $ hyphenate enHyp (Word "firefox"), "[]") -- not in the map
    ,(show $ hyphenate enHyp (Word "future."), show [(HypWord "fu",Word "ture."),(HypWord "futu",Word "re.")])
    ,(show $ hyphenate enHyp (Word "future..."), show [(HypWord "fu",Word "ture..."),(HypWord "futu",Word "re...")])
    ]
  , [
    (show $ lineBreaks enHyp 12 [Word "He",Word "who",Word "controls"], show [([Word "He",Word "who"],[Word "controls"]),([Word "He",Word "who",HypWord "co"],[Word "ntrols"]),([Word "He",Word "who",HypWord "cont"],[Word "rols"])])
    ,(show $ lineBreaks enHyp 12 [Word "He"], show [([Word "He"],[]::[Token])])
    ,(show $ lineBreaks enHyp 12 [Word "He",Word "who",Word "controls",Word "the"], show [([Word "He",Word "who"],[Word "controls",Word "the"]),([Word "He",Word "who",HypWord "co"],[Word "ntrols",Word "the"]),([Word "He",Word "who",HypWord "cont"],[Word "rols",Word "the"])])
    ]
  , [
    (show $ insertions 'x' "abcd", show ["xabcd","axbcd","abxcd","abcxd","abcdx"])
    ]
  , [
    (show $ insertBlanks 2 [Word "He",Word "who",Word "controls"], show [[Word "He",Blank,Blank,Word "who",Word "controls"],[Word "He",Blank,Word "who",Blank,Word "controls"],[Word "He",Word "who",Blank,Blank,Word"controls"]])
    ]
  , [
    (show $ blankDistances [Word "He",Blank,Blank,Word "who",Word "controls"], show [1::Integer,0,2])
    ,(show $ (map blankDistances $ insertBlanks 2 [Word "He",Word "who",Word "controls"]), show [[1::Integer,0,2],[1,1,1],[2,0,1]]) --blankDistances [Word "He"] 
    ,(show $ (blankDistances [Word "He"]), "[]")
    ]
  , [
    (show $ var [1,0,2], "0.6666666666666666")
    ,(show $ var [], "0.0")
    ]
  , [
    (show $ lineBadness defaultCosts [Word "He",Word "who",Word "controls"], "0.0")
    ,(show $ lineBadness defaultCosts [Word "He",Blank,Word "who",Word  "controls"], "3.625")
    ,(show $ lineBadness defaultCosts [Word "He",Blank,Word  "who",HypWord "cont"], "4.125")
    ,(show $ lineBadness defaultCosts [Word "He",Blank,Word "who",Blank,Word  "controls"], "6.0")
    ,(show $ lineBadness defaultCosts [Word "He",Blank,Blank,Word "who",Word  "controls"], "6.333333333333333")
    ]
  , [
    (show $ bestLineBreak defaultCosts enHyp 8 [Word "He",Word "who",Word "controls"], show  (Just  ([Word  "He",Blank,Blank,Word  "who"],[Word "controls"])))
    ,(show $ bestLineBreak defaultCosts enHyp 12 [Word "He",Word "who",Word "controls"], show (Just ([Word "He",Word "who",HypWord "cont"],[Word   "rols"])))
    ,(show $ bestLineBreak defaultCosts enHyp 1 [Word "He",Word "who",Word "controls"], "Nothing")
    ]
  , [
    (show $ justifyLine  defaultCosts  enHyp  8  (str2line text), show  [[Word   "He",Blank,Blank,Word   "who"],[Word   "controls"],[Word  "the",Word "past"],[Word  "controls"],[Word "the",Blank,HypWord "fu"],[Word "ture.",Word "He"],[Word "who",Blank,HypWord "co"],[Word
 "ntrols",Word "the",Word "present",Word "controls",Word "the",Word "past."]])
    ,(show $ justifyText  defaultCosts  enHyp  8  text , show ["He     who","controls","the past","controls","the   fu-","ture. He","who   co-","ntrols the present controls the past."])
    ]
  ]

test2str :: (Int,[(String,String)]) -> String
test2str (x,y) =
  case dropWhile (\(_,(a,b))->a==b) (zip [1::Integer ..] y) of
    [] -> "Part "++(show x)++" works on given examples."
    ((n,(act,ex)):_) -> "---------------------\nPart "++(show x)++" FAILED\n  Test case "++(show n)++" failed\n  Expected Output: "++ex++"\n    Actual Output: "++act++"\n---------------------"

main :: IO ()
main = putStr $ unlines $ map test2str $ zip [1..] tests