IO.hs

module Taskell.IO where

import ClassyPrelude

import Control.Monad.Reader (runReader)
import Data.Text.Encoding   (decodeUtf8With)
import System.Directory     (doesFileExist, doesDirectoryExist, canonicalizePath, makeRelativeToCurrentDirectory)
import Data.Either (fromRight)

import Data.Time.Zones (TZ)

import Taskell.Config     (githubUsage, trelloUsage, usage, version)
import Taskell.Data.Lists (Lists, analyse, initial)

import           Taskell.IO.Config         (Config, general, getDir, github, markdown, templatePath,
                                            trello)
import           Taskell.IO.Config.General (filename)
import qualified Taskell.IO.Config.GitHub  as GitHub (token)
import qualified Taskell.IO.Config.Trello  as Trello (token)

import Taskell.IO.Markdown (MarkdownInfo (MarkdownInfo), parse, serialize)

import qualified Taskell.IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists)
import qualified Taskell.IO.HTTP.Trello as Trello (TrelloBoardID, getLists)

import Taskell.UI.CLI (PromptYN (PromptYes), promptYN)

data IOInfo = IOInfo
    { ioTZ     :: TZ
    , ioConfig :: Config
    }

type ReaderConfig a = ReaderT IOInfo IO a

data Next
    = Output Text
    | Error Text
    | Load FilePath
           Lists
    | Exit


getPath :: Text -> ReaderConfig FilePath
getPath path = do
    config <- asks ioConfig
    canonicial <- lift $ canonicalizePath (unpack path)
    let defaultFilename = filename (general config)
    isDir <- lift $ doesDirectoryExist canonicial
    pure $ if isDir then canonicial </> defaultFilename else canonicial

parseArgs :: [Text] -> ReaderConfig Next
parseArgs ["-v"]                   = pure $ Output version
parseArgs ["-h"]                   = pure $ Output usage
parseArgs ["-t", boardID, file]    = getPath file >>= loadTrello boardID
parseArgs ["-g", identifier, file] = getPath file >>= loadGitHub identifier
parseArgs ["-i", file]             = getPath file >>= fileInfo
parseArgs [file]                   = getPath file >>= loadFile
parseArgs []                       = getPath "" >>= loadFile
parseArgs _                        = pure $ Error (unlines ["Invalid options", "", usage])

load :: ReaderConfig Next
load = getArgs >>= parseArgs

colonic :: FilePath -> Text -> Text
colonic path = ((pack path <> ": ") <>)

createLoad :: FilePath -> Lists -> ReaderConfig Next
createLoad path lists = do
    relative <- lift $ makeRelativeToCurrentDirectory path
    pure $ Load relative lists

loadFile :: FilePath -> ReaderConfig Next
loadFile filepath = do
    mPath <- exists filepath
    case mPath of
        Nothing   -> pure Exit
        Just path -> do
            lists <- readData path
            case lists of
                Left err -> pure $ Error (colonic path err)
                Right ls -> createLoad path ls

loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> FilePath -> ReaderConfig Next
loadRemote createFn identifier path = do
    exists' <- fileExists path
    if exists'
        then pure $ Error (pack path <> " already exists")
        else createFn identifier path

loadTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next
loadTrello = loadRemote createTrello

loadGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next
loadGitHub = loadRemote createGitHub

fileInfo :: FilePath -> ReaderConfig Next
fileInfo path = do
    exists' <- fileExists path
    if exists'
        then either (Error . colonic path) (Output . analyse (pack path)) <$> readData path
        else pure $ Error (pack path <> " does not exist")

createRemote ::
       (Config -> Maybe token)
    -> Text
    -> (token -> ReaderT token IO (Either Text Lists))
    -> token
    -> FilePath
    -> ReaderConfig Next
createRemote tokenFn missingToken getFn identifier path = do
    config <- asks ioConfig
    tz <- asks ioTZ
    case tokenFn config of
        Nothing -> pure $ Error missingToken
        Just token -> do
            lists <- lift $ runReaderT (getFn identifier) token
            case lists of
                Left txt -> pure $ Error txt
                Right ls -> do
                    promptCreate path >>= bool (pure Exit) (lift (writeData tz config ls path) >> createLoad path ls)

createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next
createTrello = createRemote (Trello.token . trello) trelloUsage Trello.getLists

createGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next
createGitHub = createRemote (GitHub.token . github) githubUsage GitHub.getLists

exists :: FilePath -> ReaderConfig (Maybe FilePath)
exists path = do
    exists' <- fileExists path
    if exists'
        then pure $ Just path
        else promptCreate path >>= bool (pure Nothing) (Just path <$ createPath path)

fileExists :: FilePath -> ReaderConfig Bool
fileExists path = lift $ doesFileExist path

promptCreate :: FilePath -> ReaderConfig Bool
promptCreate path = lift $ promptYN PromptYes $ concat ["Create ", pack path, "?"]

-- creates taskell file
createPath :: FilePath -> ReaderConfig ()
createPath path = do
    config <- asks ioConfig
    tz <- asks ioTZ
    template <- readData . templatePath =<< lift getDir
    let ls = fromRight initial template
    lift (writeData tz config ls path)

-- writes Tasks to json file
writeData :: TZ -> Config -> Lists -> FilePath -> IO ()
writeData tz config tasks path = void (writeFile path output)
  where
    output = encodeUtf8 $ runReader (serialize tasks) (MarkdownInfo tz (markdown config))

-- reads json file
decodeError :: String -> Maybe Word8 -> Maybe Char
decodeError _ _ = Just '\65533'

readData :: FilePath -> ReaderConfig (Either Text Lists)
readData path =
    parse <$> (markdown <$> asks ioConfig) <*> (decodeUtf8With decodeError <$> readFile path)