{-# LANGUAGE TemplateHaskell #-}
module UI.CardSelector 
  (runCardSelectorUI
  , getRecents
  , getRecentsFile
  , addRecent
  , runCardsWithOptions) where

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Control.Exception (displayException, try)
import Control.Monad (filterM)
import Control.Monad.IO.Class
import Data.Functor (void)
import Data.List (sort)
import Data.Random
import Lens.Micro.Platform
import Parser
import Stack (Stack)
import System.Environment (lookupEnv)
import System.FilePath ((</>), splitFileName, dropExtension, splitPath, joinPath)
import Types
import UI.BrickHelpers
import UI.FileBrowser (runFileBrowserUI)
import UI.Cards (runCardsUI, Card)
import qualified Brick.Widgets.List as L
import qualified Data.Vector as Vec
import qualified Graphics.Vty as V
import qualified Stack as S
import qualified System.Directory as D
import qualified System.IO.Strict as IOS (readFile)

type Event = ()
type Name = ()
data State = State
  { _list       :: L.List Name String
  , _exception  :: Maybe String
  , _recents    :: Stack FilePath
  , _gs         :: GlobalState
  }

makeLenses ''State

app :: App State Event Name
app = App 
  { appDraw = drawUI
  , appChooseCursor = neverShowCursor
  , appHandleEvent = handleEvent
  , appStartEvent = return
  , appAttrMap = const theMap
  }

drawUI :: State -> [Widget Name]
drawUI s = 
  [ drawMenu s <=> drawException s ]

title :: Widget Name
title = withAttr titleAttr $ hCenteredStrWrap "Select a deck of flashcards"

drawMenu :: State -> Widget Name
drawMenu s = 
  joinBorders $
  center $ 
  withBorderStyle unicodeRounded $
  border $
  hLimitPercent 60 $
  title <=>
  hBorder <=>
  hCenter (drawList s)

drawList :: State -> Widget Name
drawList s = vLimit 6  $
             L.renderListWithIndex (drawListElement l) True l
              where l = s ^. list

drawListElement :: L.List Name String -> Int -> Bool -> String -> Widget Name
drawListElement l i selected = hCenteredStrWrapWithAttr (wAttr1 . wAttr2)
  where wAttr1 = if selected then withDefAttr selectedAttr else id
        wAttr2 = if i == length l - 1 then withAttr lastElementAttr else id

drawException :: State -> Widget Name
drawException s = case s ^. exception of
  Nothing -> emptyWidget
  Just exc  -> withAttr exceptionAttr $ strWrap exc

titleAttr :: AttrName
titleAttr = attrName "title"

selectedAttr :: AttrName
selectedAttr = attrName "selected"

lastElementAttr :: AttrName
lastElementAttr = attrName "last element"

exceptionAttr :: AttrName
exceptionAttr = attrName "exception"

theMap :: AttrMap
theMap = attrMap V.defAttr
    [ (L.listAttr, V.defAttr)
    , (selectedAttr, fg V.white `V.withStyle` V.underline)
    , (titleAttr, fg V.yellow)
    , (lastElementAttr, fg V.blue)
    , (exceptionAttr, fg V.red) ]

handleEvent :: State -> BrickEvent Name Event -> EventM Name (Next State)
handleEvent s@State{_list=l} (VtyEvent e) =
    case e of
        V.EvKey (V.KChar 'c') [V.MCtrl]  -> halt s
        V.EvKey V.KEsc [] -> halt s

        _ -> do l' <- L.handleListEventVi L.handleListEvent e l
                let s' = (s & list .~ l') in
                  case e of
                    V.EvKey V.KEnter [] ->
                      case L.listSelectedElement l' of
                        Nothing -> continue s'
                        Just (_, "Select file from system") -> suspendAndResume $ runFileBrowser s'
                        Just (i, _) -> do
                            let fp = (s' ^. recents) `S.unsafeElemAt` i
                            fileOrExc <- liftIO (try (readFile fp) :: IO (Either IOError String))
                            case fileOrExc of
                              Left exc -> continue (s' & exception ?~ displayException exc)
                              Right file -> case parseCards file of
                                Left parseError -> continue (s' & exception ?~ show parseError)
                                Right result -> suspendAndResume $ do
                                  s'' <- addRecentInternal s' fp
                                  _ <- runCardsWithOptions (s^.gs) result
                                  return (s'' & exception .~ Nothing)
                    _ -> continue s'

handleEvent l _ = continue l

runCardSelectorUI :: GlobalState -> IO ()
runCardSelectorUI gs = do
  rs <- getRecents
  let prettyRecents = shortenFilepaths (S.toList rs)
  let options = Vec.fromList (prettyRecents ++ ["Select file from system"])
  let initialState = State (L.list () options 1) Nothing rs gs
  _ <- defaultMain app initialState
  return () 

getRecents :: IO (Stack FilePath)
getRecents = do
  rf <- getRecentsFile
  exists <- D.doesFileExist rf
  if exists
    then removeDeletedFiles rf
    else return S.empty

removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles fp = do
  file <- IOS.readFile fp
  existing <- S.fromList <$> filterM D.doesFileExist (lines file)
  writeRecents existing
  return existing

maxRecents :: Int
maxRecents = 5

addRecent :: FilePath -> IO ()
addRecent fp = do
  rs <- getRecents
  let rs'  = fp `S.insert` rs 
      rs'' = if S.size rs' <= maxRecents
              then rs'
              else S.removeLast rs'
  writeRecents rs''

addRecentInternal :: State -> FilePath -> IO State
addRecentInternal s fp = do
  addRecent fp
  refreshRecents s

writeRecents :: Stack FilePath -> IO ()
writeRecents stack = do
  file <- getRecentsFile
  writeFile file $ unlines (S.toList stack)

getRecentsFile :: IO FilePath
getRecentsFile = do
  maybeSnap <- lookupEnv "SNAP_USER_DATA"
  xdg <- D.getXdgDirectory D.XdgData "hascard"

  let dir = case maybeSnap of
                Just path | not (null path) -> path
                          | otherwise       -> xdg
                Nothing                     -> xdg
  D.createDirectoryIfMissing True dir

  return (dir </> "recents")

initLast :: [a] -> ([a], a)
initLast [x] = ([], x)
initLast (x:xs) = let (xs', y) = initLast xs
                   in (x:xs', y)

shortenFilepaths :: [FilePath] -> [FilePath]
shortenFilepaths fps = uncurry shortenFilepaths' (unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps))
  where
    shortenFilepaths' prefixes abbreviations =
      let ds = duplicates abbreviations in
        if null ds then abbreviations else
          shortenFilepaths' 
            (flip map (zip [0..] prefixes) (
              \(i, pre) -> if i `elem` ds then
                joinPath (init (splitPath pre)) else pre
            ))
            (flip map (zip [0..] abbreviations) (
              \(i, abbr) -> if i `elem` ds then 
                last (splitPath (prefixes !! i)) ++ abbr
                else abbr) )
          

duplicates :: Eq a => [a] -> [Int]
duplicates = sort . map fst . duplicates' 0 [] []
  where duplicates' _ _    acc []     = acc
        duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs
          where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of
                  ([], []) -> acc
                  ([], ys) -> (i, x) : ys ++ acc
                  (_, _)   -> (i, x) : acc
                -- acc' = if getPairsWithValue x seen then (i, x) : acc else acc 

getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue y []       = []
getPairsWithValue y ((i, x):xs)
  | x == y    = (i, x) : getPairsWithValue y xs
  | otherwise = getPairsWithValue y xs

refreshRecents :: State -> IO State
refreshRecents s = do
  rs <- getRecents
  let prettyRecents = shortenFilepaths (S.toList rs)
      options       = Vec.fromList (prettyRecents ++ ["Select file from system"])
  return $ s & recents .~ rs
             & list    .~ L.list () options 1

runFileBrowser :: State -> IO State
runFileBrowser s = do
  result <- runFileBrowserUI
  maybe (return s) (\(cards, fp) -> addRecentInternal s fp <* runCardsWithOptions (s^.gs) cards) result

runCardsWithOptions :: GlobalState -> [Card] -> IO ()
runCardsWithOptions state cards =
  let n = length cards in do
    cards' <- if state^.doShuffle then sampleFrom (state^.mwc) (shuffleN n cards) else return cards
    void $ maybe (runCardsUI state cards') (\n -> runCardsUI state (take n cards')) (state^.subset)