{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module Reporting.Helpers
  ( textToDoc
  , nameToDoc
  , args, moreArgs
  , toSimpleNote, toSimpleHint, toFancyHint
  , link, reflowLink
  , stack, reflow
  , commaSep, capitalize, ordinalize, drawCycle
  , findPotentialTypos, findTypoPairs, vetTypos
  , nearbyNames, distance, maybeYouWant, maybeYouWant'
  -- re-exports
  , Doc, (<+>), (<>), black, cat, dullyellow, fillSep, green, hang, hardline
  , hcat, hsep, indent, magenta, parens, sep, text, underline, vcat
  )
  where


import Data.Function (on)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Monoid ((<>))
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Elm.Name as N
import qualified Text.EditDistance as Dist
import qualified Text.PrettyPrint.ANSI.Leijen as P
import Text.PrettyPrint.ANSI.Leijen hiding ((<>))

import qualified Elm.Compiler.Version as Compiler
import qualified Elm.Package as Pkg



-- DOC HELPERS


textToDoc :: Text -> Doc
textToDoc msg =
  text (Text.unpack msg)


nameToDoc :: N.Name -> Doc
nameToDoc name =
  text (N.toString name)


args :: Int -> String
args n =
  show n <> if n == 1 then " argument" else " arguments"


moreArgs :: Int -> String
moreArgs n =
  show n <> " more" <> if n == 1 then " argument" else " arguments"



-- HINTS


toSimpleNote :: String -> Doc
toSimpleNote message =
  fillSep ((underline (text "Note") <> ":") : map text (words message))


toSimpleHint :: String -> Doc
toSimpleHint message =
  toFancyHint (map text (words message))


toFancyHint :: [Doc] -> Doc
toFancyHint chunks =
  fillSep (underline (text "Hint") <> ":" : chunks)


link :: Doc -> String -> String -> String -> Doc
link word before fileName after =
  fillSep $
    (underline word <> ":")
    : map text (words before)
    ++ P.text (makeLink fileName)
    : map text (words after)


makeLink :: String -> String
makeLink fileName =
  "<http://elm-lang.org/hints/" <> Pkg.versionToString Compiler.version <> "/" <> fileName <> ".md>"


reflowLink :: String -> String -> String -> Doc
reflowLink before fileName after =
  fillSep $
    map text (words before)
    ++ P.text (makeLink fileName)
    : map text (words after)


stack :: [Doc] -> Doc
stack chunks =
  case chunks of
    [] ->
        error "function `stack` requires a non-empty list of docs"

    doc : docs ->
        List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs


reflow :: String -> Doc
reflow paragraph =
  fillSep (map text (words paragraph))


commaSep :: Doc -> (Doc -> Doc) -> [Doc] -> [Doc]
commaSep conjunction addStyle names =
  case names of
    [name] ->
      [ addStyle name ]

    [name1,name2] ->
      [ addStyle name1, conjunction, addStyle name2 ]

    _ ->
      map (\name -> addStyle name <> ",") (init names)
      ++
      [ conjunction
      , addStyle (last names)
      ]


capitalize :: Text -> Text
capitalize txt =
  case Text.uncons txt of
    Nothing ->
      txt

    Just (c, rest) ->
      Text.cons (Char.toUpper c) rest


ordinalize :: Int -> String
ordinalize number =
  let
    remainder10 =
      number `mod` 10

    remainder100 =
      number `mod` 100

    ending
      | remainder100 `elem` [11..13] = "th"
      | remainder10 == 1             = "st"
      | remainder10 == 2             = "nd"
      | remainder10 == 3             = "rd"
      | otherwise                    = "th"
  in
    show number <> ending



drawCycle :: [N.Name] -> Doc
drawCycle names =
  let
    topLine =
      "┌─────┐"

    nameLine name =
      "│    " <> dullyellow (textToDoc name)

    midLine =
      "│     ↓"

    bottomLine =
      "└─────┘"
  in
    vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])



-- FIND TYPOS


findPotentialTypos :: [String] -> String -> [String]
findPotentialTypos knownNames badName =
  filter ((==1) . distance badName) knownNames


findTypoPairs :: [String] -> [String] -> [(String, String)]
findTypoPairs leftOnly rightOnly =
  let
    veryNear leftName =
      map ((,) leftName) (findPotentialTypos rightOnly leftName)
  in
    concatMap veryNear leftOnly


vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
vetTypos potentialTypos =
  let
    tallyNames (ln, rn) (lc, rc) =
      ( Map.insertWith (+) ln 1 lc
      , Map.insertWith (+) rn 1 rc
      )

    (leftCounts, rightCounts) =
      foldr tallyNames (Map.empty, Map.empty) potentialTypos

    acceptable :: Map.Map String Int -> Bool
    acceptable counts =
      not (Map.null counts)
      &&
      Map.foldr (\n unique -> n < 2 && unique) True counts
  in
    if acceptable leftCounts && acceptable rightCounts then
        Just (Map.keysSet leftCounts, Map.keysSet rightCounts)

    else
        Nothing



-- NEARBY NAMES


nearbyNames :: (a -> String) -> a -> [a] -> [a]
nearbyNames format name names =
  let editDistance =
        if length (format name) < 3 then 1 else 2
  in
  map snd $
    filter ( (<= editDistance) . abs . fst ) $
      List.sortBy (compare `on` fst) $
        map (\x -> (distance (format name) (format x), x)) names


distance :: String -> String -> Int
distance x y =
  Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y


maybeYouWant :: Maybe Doc -> [N.Name] -> Doc
maybeYouWant maybeStarter suggestions =
  maybe P.empty id (maybeYouWant' maybeStarter suggestions)


maybeYouWant' :: Maybe Doc -> [N.Name] -> Maybe Doc
maybeYouWant' maybeStarter suggestions =
  case suggestions of
    [] ->
      maybeStarter

    _:_ ->
      Just $ stack $
        [ maybe id (<+>) maybeStarter "Maybe you want one of the following?"
        , P.indent 4 $ P.vcat $ map (P.dullyellow . nameToDoc) (take 4 suggestions)
        ]