{-# LANGUAGE OverloadedStrings#-}
-- |
-- Module      : Spellchecker.Checker
-- Description : Correct one word.
-- Copyright   : (c) Maximilian Nitsch, 2015
--
-- License     : MIT
-- Maintainer  : maximilian.nitsch@gausus.de
-- Stability   : experimental
-- Portability : portable
--
-- This module cooperate with @Spell@ module to correct a word.

module Spellchecker.Checker
       ( -- * Data types
        Penalties (..)
       , Slice (..)
         -- * Correction function
       , correctWord
         -- * Interaction with world
       , trieFromFile
       , readInput
       , interact
       ) where

import Spellchecker.Spell

import Prelude hiding (Word, interact)

import Control.Applicative ((<|>))
import Control.Monad (forM_, unless)
import Data.List (sortBy)
import Data.Char (isAlpha, isNumber)
import qualified Data.Trie as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TLI
import System.IO hiding (interact)
import Data.Ord (comparing)
import qualified Data.Map as M

-- | Generates a @DictTrie@ from a given word corpus
trieFromFile :: FilePath -> IO DictTrie
trieFromFile f = genTrie <$> TL.words <$> TLI.readFile f
  where genTrie = foldr addWord $ T.singleton (DictNode ' ' [])

{-
-- | Add a word using @T.insert@, use a bit more memory
addWord :: TL.Text -> DictTrie -> DictTrie
addWord = T.insert createNode
  where createNode c = DictNode c []
-}

-- | Adds a new word to a @DictTrie@
addWord :: TL.Text -> DictTrie -> DictTrie
addWord word trie =
  -- Use this instead of @T.insert@ because use less of memory, @uncons@ is not
  -- in ListLike
  case TL.uncons word of
   Nothing     -> trie {T.isFinal = True}
   Just (x,xs) -> trie {T.subTries = next `seq` M.insert x next (T.subTries trie)}
     where
       next = case M.lookup x (T.subTries trie) of
               Nothing -> addWord xs $ T.singleton value
               Just st -> addWord xs st
       value = DictNode x []

-- | Data structure to differentiate a relevant word and punctuation stuff.
data Slice = Word TL.Text | Misc TL.Text deriving (Show)

-- | Walk through a file and construct slices.
readInput :: FilePath -> IO [Slice]
readInput f = parse "" <$> TL.unpack <$> TLI.readFile f
  where
    parse [] [] = []
    parse a@(y:_) []
      | isAlpha y = [Word $ (TL.pack . reverse) a]
      | otherwise = [Misc $ (TL.pack . reverse) a]
    -- Put Char in empty temporary list and parse remain input
    parse [] (x:xs) = parse [x] xs
    -- Compare next @Char@ with temporary stuff, if equal append otherwise put
    -- temporary stuff to return and create a new temporary list
    parse a@(y:_) (x:xs)
      | isAlpha y && (not . isAlpha) x =
          (Word $ (TL.pack . reverse) a) : parse [x] xs
      | (not . isAlpha) y && isAlpha x =
          (Misc $ (TL.pack . reverse) a) : parse [x] xs
      | otherwise = parse (x:a) xs


-- | Calculates suggestions for a word, choose one and return it.
correctWord :: (TL.Text -> [Suggestion] -> IO (Maybe TL.Text))
                          -- ^ Function to choose one suggestion
            -> DictTrie   -- ^ Dictionary Trie
            -> Penalties  -- ^ Penalty functions
            -> Unit       -- ^ Distance limit
            -> Int        -- ^ Number of suggestions
            -> TL.Text    -- ^ Misspelled word
            -> IO TL.Text
correctWord ldns trie penalties limit count word' = do
  let word = TL.unpack word'
  if T.member word trie
    then return word'
    else do
     let suggs = take count
                 $ sortBy (comparing fst) -- Least distance first
                 $ suggest word penalties limit trie -- Calculate suggestions
     sugg <- ldns word' suggs -- Apply choose function
     case sugg of
      -- Call this function again with increased count
      Nothing -> correctWord ldns trie penalties limit (count + 5) word'
      Just w  -> return w

interact :: Bool -> TL.Text -> [Suggestion] -> IO (Maybe TL.Text)
interact q = if q then silent else ask

-- | Don't ask the user, always choose best match.
silent :: TL.Text -> [Suggestion] -> IO (Maybe TL.Text)
silent w []        = return $ Just w
silent _ ((_,w):_) = return $ Just w


-- | Function ask user which suggestion is to be used and return selection.
ask :: TL.Text -> [Suggestion] -> IO (Maybe TL.Text)
ask w ss = do
  TLI.putStr "Maybe misspelled: "
  TLI.putStrLn w
  TLI.putStrLn ""
  if null ss
    then TLI.putStrLn "No suggestions found"
    else TLI.putStrLn "Suggestions:"
  forM_ suggestions $ \(i, s) -> do
    TLI.putStr "  "
    TLI.putStr i
    TLI.putStr ") "
    TLI.putStrLn s
  TLI.putStrLn ""
  TLI.putStr "(k)eep it anyway || Replace with (word)"
  unless (null ss)
    $ TLI.putStr " || Replace with suggestion number (n) || (Return) More suggestions"
  TLI.putStrLn "\n"
  TLI.putStr "Your choice: "
  hFlush stdout
  w' <- TLI.getLine
  case w' of
   ""  -> return Nothing
   "k" -> return $ Just w
   _ -> if isNumber $ TL.head w'
        then return $ lookup w' suggestions <|> Just w
        else return $ Just w'
  where
    numbers = map (TL.pack . show) [1 :: Int ..]
    suggestions = zip numbers (map snd ss)
