{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module KitsuneBook.Internal where

import           Common
import           Configurator
import qualified Data.Text as Text
import           Data.Text.Read (decimal)
import           Filesystem.CanonicalPath.Directory
                 (getDirectoryContents, createDirectory, createDirectory_)
import           Filesystem.Path (dropExtension, extension)
import           KitsuneBook.Shell

-- read note info

noteInfo :: Int -> KitsuneBook NoteInfo
noteInfo i = pathForTarget (TargetNoteInfo i) >>= noteInfo'

noteInfo' :: CanonicalPath -> KitsuneBook NoteInfo
noteInfo' path =
  do info <- defInfo
     config <- load $ Optional path
     NoteInfo <$> lookupOptional (noteName info) config "title"
              <*> lookupOptional (noteTags info) config "tags"
              <*> lookupOptional (noteDescription info) config "description"
              <*> lookupOptional (noteExtension info) config "extension"

defInfo :: KitsuneBook NoteInfo
defInfo =
  do settings <- askSettings
     return
       NoteInfo {noteName = "Yet another empty note"
                ,noteTags = []
                ,noteDescription = ""
                ,noteExtension = defaultNoteExtension settings}

noteInfoToText :: NoteInfo -> Text
noteInfoToText info = Text.unlines
  ["title = " ++ quote (noteName info)
  ,"tags = [" ++ Text.intercalate ", " (map quote $ noteTags info) ++ "]"
  ,"description = " ++ quote (noteDescription info)
  ,"extension = " ++ quote (noteExtension info)]
  where quote s = "\"" ++ s ++ "\""

readNotes :: KitsuneBook [(Int, NoteInfo)]
readNotes = askDomain >>= readNotes'

readNotes' :: Domain -> KitsuneBook [(Int, NoteInfo)]
readNotes' domain =
  getIds' domain >>=
  \ids ->
    liftM (zip ids) $
    mapM noteInfo ids

-- get ids stuff

getNextId :: KitsuneBook Int
getNextId = askDomain >>= getNextId'

getNextId' :: Domain -> KitsuneBook Int
getNextId' = liftM ((+ 1) . maximum . (0:)) . getIds'

getIds :: KitsuneBook [Int]
getIds = askDomain >>= getIds'

getIds' :: Domain -> KitsuneBook [Int]
getIds' domain =
  domainPath' domain >>= getDirectoryContents >>=
  liftM sort .
  mapM (parseID . toTextUnsafe) .
  filterNoteFolders

filterNoteFolders :: [FilePath] -> [FilePath]
filterNoteFolders = filter isNoteFolder
  where isNoteFolder p = andP p predicates
        predicates = [not . isDotPath
                     ,(/= domainDir DomainTrash)
                     ,(/= domainDir DomainArchive)
                     ,(/= domainDir DomainMain)]
        isDotPath = (==) '.' . Text.head . toTextUnsafe

parseID :: Text -> KitsuneBook Int
parseID t =
  case decimal t of
    Left _ -> error $
                "Failed to parse note id from folder's name: '" ++
                t ++
                "'. Probably you need to change it's name to unique number."
    Right (v,_) -> return v

-- moving notes

moveNote :: Int -> Domain -> KitsuneBook ()
moveNote noteIdFrom domainTo  =
  do pathFrom <- pathForTarget $ TargetNoteRoot noteIdFrom
     noteIdTo <- getNextId' domainTo
     base <- domainPath' domainTo
     mv (unsafePath pathFrom) (unsafePath base </> fromText (show noteIdTo))
     swiftNotes

changeNoteExtension :: Int -> Text -> KitsuneBook ()
changeNoteExtension noteId newExtension =
  do info <- noteInfo noteId
     infoPath <- pathForTarget $ TargetNoteInfo noteId
     nPath <- pathForTarget $ TargetNote noteId
     writeFile infoPath (noteInfoToText $ info { noteExtension = newExtension })
     let p0 = unsafePath nPath
         p1 = dropExtension p0 <.> Text.tail newExtension
       in mv p0 p1

changeID :: Int -> Int -> KitsuneBook ()
changeID from to =
  when (from /= to) $
  do p <- pathForTarget $ TargetNoteRoot from
     domPath <- domainPath
     exists <- doesNoteExist to
     if exists
        then error errorMsg
        else mv (unsafePath p) $ unsafePath domPath </> fromText (show to)

     where errorMsg = "Couldn't change <" ++ show from ++ "> to <" ++ show to ++ ">, because there is already note with id <" ++ show to ++ ">."

swiftNotes :: KitsuneBook ()
swiftNotes = isViolated >>= \violated -> when violated $
  do ids <- getIds
     mapM_ (uncurry changeID) $ zip ids [1..]

isViolated :: KitsuneBook Bool
isViolated = liftM (not . isSequence . map fst) readNotes
  where isSequence :: [Int] -> Bool
        isSequence xs = xs == take (length xs) [1..]

-- create new note

parseNoteInfo :: [Text] -> KitsuneBook NoteInfo
parseNoteInfo args =
  do info <- defInfo
     if isEmpty
        then return info
        else return NoteInfo {noteName =
                                fromMaybe (noteName info) maybeTitle
                             ,noteTags =
                                fromMaybe (noteTags info) maybeTags
                             ,noteDescription =
                                fromMaybe (noteDescription info) maybeDescription
                             ,noteExtension =
                                fromMaybe (noteExtension info) maybeExtension}
  where query = parseQuery args
        maybeTitle =
          if null . qWords $ query
             then Nothing
             else Just .
                  Text.intercalate " " .
                  qWords $
                  query
        maybeTags =
          if null . qTags $ query
             then Nothing
             else Just . qTags $ query
        maybeDescription = Nothing
        maybeExtension =
          if Text.null . qExt $ query
             then Nothing
             else Just . qExt $ query
        isEmpty =
          null args ||
          all Text.null args

createNewNote :: [Text] -> KitsuneBook ()
createNewNote args =
  do nextId <- getNextId
     domDir <- domainPath
     -- create note directory
     noteDir <- createDirectory domDir (fromText . show $ nextId)
     -- create assets directory
     createDirectory_ noteDir "assets"
     -- create note info
     info <- parseNoteInfo args
     writeFile' noteDir noteInfoFileName (noteInfoToText info)
     -- create empty note
     -- todo : use template
     writeFile' noteDir (fromText $ noteFileName info) ""
     lift $ return ()

-- commands

viewCommand :: CommandTarget -> KitsuneBook Text
viewCommand target =
  case target of
    TargetNote i -> noteInfo i >>= viewCommandForNote
    TargetNoteInfo _ -> viewInfoCommand <$> askSettings
    TargetNoteAssets _ -> viewFolderCommand <$> askSettings
    TargetNoteRoot _ -> viewFolderCommand <$> askSettings
    TargetSettings -> viewInfoCommand <$> askSettings

editCommand :: CommandTarget -> KitsuneBook Text
editCommand target =
  case target of
    TargetNote i -> noteInfo i >>= editCommandForNote
    TargetNoteInfo _ -> editInfoCommand <$> askSettings
    TargetNoteAssets _ -> error "Sorry, but you can't edit folders!"
    TargetNoteRoot _ -> error "Sorry, but you can't edit folders!"
    TargetSettings -> editInfoCommand <$> askSettings

viewCommandForNote :: NoteInfo -> KitsuneBook Text
viewCommandForNote note =
  let ext = noteExtension note
  in do settings <- askSettings
        case lookup' ext "*" $ viewNoteCommand settings of
          Just cmd -> lift . return $ cmd
          Nothing -> error $ "Couldn't find view command for extension: " ++ ext ++ "."

editCommandForNote :: NoteInfo -> KitsuneBook Text
editCommandForNote note =
  let ext = noteExtension note
  in do settings <- askSettings
        case lookup' ext "*" $ editNoteCommand settings of
          Just cmd -> lift . return $ cmd
          Nothing -> error $ "Couldn't find edit command for extension: " ++ ext ++ "."

lookup' :: Eq a => a -> a -> [(a, b)] -> Maybe b
lookup' key1 key2 list = lookup key1 list <|> lookup key2 list

-- path realted

domainDir :: IsString a => Domain -> a
domainDir DomainMain = "main"
domainDir DomainTrash = "trash"
domainDir DomainArchive = "archive"

domainPath :: KitsuneBook CanonicalPath
domainPath = askDomain >>= domainPath'

domainPath' :: Domain -> KitsuneBook CanonicalPath
domainPath' domain =
  do wd <- validateWorkingDirectory
     resultMaybe <- canonicalPathM $ wd <///> domainDir domain
     case resultMaybe of
       Nothing -> createDirectory wd $ domainDir domain
       Just result -> lift . return $ result

pathForTarget :: CommandTarget -> KitsuneBook CanonicalPath
pathForTarget target =
  case target of
    TargetNote i -> noteInfo i >>= mkPath i . noteFileName
    TargetNoteInfo i -> mkPath i noteInfoFileName
    TargetNoteAssets i -> pathForTarget (TargetNoteRoot i) >>= (<//> "assets")
    TargetNoteRoot i -> mkPath i ""
    TargetSettings -> askSettingsPath >>= canonicalPath'

mkPath :: Int -> Text -> KitsuneBook CanonicalPath
mkPath noteId file =
  do root <- noteDirectory noteId
     resultM <- canonicalPathM $ root </> fromText file
     case resultM of
       Nothing -> do validateNote 0 noteId
                     mkPath noteId file
       Just result -> return result

noteDirectory :: Int -> KitsuneBook FilePath
noteDirectory noteId =
  askDomain >>= noteDirectory' noteId

noteDirectory' :: Int -> Domain -> KitsuneBook FilePath
noteDirectory' noteId domain =
  do base <- domainPath' domain
     return $ unsafePath base ++ fromText (show noteId)

doesNoteExist :: Int -> KitsuneBook Bool
doesNoteExist noteId = noteDirectory noteId >>= liftM isJust . canonicalPathM

noteInfoFileName :: IsString a => a
noteInfoFileName = "info.cfg"

noteFileName :: NoteInfo -> Text
noteFileName = ("note" ++) . validateExt . noteExtension

noteDoesNotExist :: Int -> Text
noteDoesNotExist i = "Sorry, but no note with id <" ++ show i ++ "> found. Maybe you sould create it before trying to do something with it."

(<//>) :: MonadIO m => CanonicalPath -> FilePath -> m CanonicalPath
cp <//> up = canonicalPath $ cp <///> up

(<///>) :: CanonicalPath -> FilePath -> FilePath
cp <///> up = unsafePath cp </> up

-- validation

doctor :: KitsuneBook ()
doctor =
  do say 0 "Validating working directory."
     wd <- validateWorkingDirectory
     say 0 $ "Found working directory at '" ++ toText' wd ++ "'."
     validateDomain' DomainMain
     validateDomain' DomainTrash
     validateDomain' DomainArchive
     say 0 "Done..."

validateWorkingDirectory :: KitsuneBook CanonicalPath
validateWorkingDirectory =
  do settings <- askSettings
     wdMaybe <- canonicalPathM' $ workingDirectory settings
     case wdMaybe of
       -- in future we might prompt user to create it
       Nothing -> askSettingsPath >>= error . errMsg (workingDirectory settings)
       Just cp -> return cp
  where errMsg wd sp = "Working directory at '" ++
                       wd ++
                       "' doesn't exist. Check your settings file at '" ++
                       sp ++
                       "' to ensure that the path to working directory is correct. Otherwise, manually create working directory. Sorry for any inconvenience."

validateDomain :: KitsuneBook ()
validateDomain = askDomain >>= validateDomain'

validateDomain' :: Domain -> KitsuneBook ()
validateDomain' domain =
  do say 0 $ "Validating " ++ show domain ++ "."
     getIds' domain >>= mapM_ validateNote''
     -- swiftNotes also call note validation
     -- so it should be performed at the very end
     -- but really it should not call any note validation
     swiftNotes
  where validateNote'' noteId =
          do say 1 $ "Validating note <" ++ show noteId ++ ">"
             validateNote' 2 noteId domain

validateNote :: Int -> Int -> KitsuneBook ()
validateNote indentLevel noteId =
  askDomain >>= validateNote' indentLevel noteId

validateNote' :: Int -> Int -> Domain -> KitsuneBook ()
validateNote' indentLevel noteId domain =
  do root <- noteDirectory' noteId domain
     rootMaybe <- canonicalPathM root
     -- validate note directory existence
     -- in case it doesn't exist - show error
     case rootMaybe of
       Nothing -> error $ "Note <" ++ show noteId ++ "> doesn't exist."
       Just noteDir ->
         -- at this point note is considered existing
         do rootContent <- getDirectoryContents noteDir
            -- check note info file existence
            -- in case it doesn't exist -
            -- create default one
            unless (noteInfoFileName `elem` rootContent) $
              do say indentLevel "Info file doesn't exist, so trying to create one."
                 info <- defInfo
                 writeFile' noteDir noteInfoFileName (noteInfoToText info)
            -- now we can check note file existence
            info <- noteInfo' =<< canonicalPath (noteDir <///> noteInfoFileName)
            let note = fromText . noteFileName $ info
                noteExists = elem note rootContent
                currentNoteM = if noteExists then Nothing else find ((== "note"). dropExtension) rootContent in do
              unless noteExists $
                      -- in case 'note*' already exists
                      -- change it's extension to the
                      -- extension from note info
                      -- otherwise create new empty note file
                      case currentNoteM of
                        Nothing -> do say indentLevel "Note file doesn't exist, so trying to create one."
                                      writeFile' noteDir note ""
                        Just currentNote -> do say indentLevel $ wrongExtMsg currentNote note
                                               mv (root </> currentNote) (root </> note)
              -- check for assets folder existence
              -- in case it doesn't exist -
              -- create empty one
              unless ("assets" `elem` rootContent) $
                      do say indentLevel "Assets folder doesn't exist, so trying to create one."
                         createDirectory_ noteDir "assets"
              -- when note directory contains any garbage - remove it
              -- in future this operation should be considered harmfull
              -- so user should be prompted to allow rm
              let exclude = ["assets", noteInfoFileName, note, ".", "..", ".DS_Store"] ++ maybeToList currentNoteM
               in case rootContent \\ exclude of
                    [] -> return ()
                    xs -> forM_ xs $ \x ->
                      do say indentLevel $ "Found file or dir that will be removed: '" ++ toTextUnsafe x ++ "'."
                         rm (root </> x)
  where descrExt file = fromMaybe "/no extension/" (extension $ file)
        wrongExtMsg n1 n2 = "Found note file, but with wrong extension, so trying to change it's extension from '" ++ descrExt n1 ++ "' to '" ++ descrExt n2 ++ "'."

-- query

data Query =
  Query {qWords :: [Text]
        ,qTags :: [Text]
        ,qExt :: Text}
  deriving (Show)

parseQuery :: [Text] -> Query
parseQuery args = Query {qWords = ws
                        ,qTags = filter (not . Text.null) . map Text.tail  $ tags
                        ,qExt = if null ext
                                   then ""
                                   else validateExt . head $ ext}
  where isTag = (== '@') . Text.head
        isExt = (== '.') . Text.head
        (ws, args') = break (isTag .|| isExt) args
        (tags, ext) = break isExt args'
