module Main where

import Foundation
import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Data.ByteString (ByteString)
import Data.HashMap.Strict (HashMap)
import Data.Traversable
import qualified Data.Attoparsec.ByteString as Attoparsec
import qualified Data.ByteString
import qualified Data.ByteString.Char8
import qualified Data.Char
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List
import qualified GHC.Base
import qualified System.Environment
import qualified System.Exit
import System.Directory
import System.FilePath


-- | Files and file names are parsed into a list of this type.
data Content
  = PromptVar ByteString -- ^ prompt the user for a substitution
  | EnvVar ByteString -- ^ a shell environment variable
  | String ByteString -- ^ normal text


-- | Parse one chunk of 'Content'.
parseChunk :: Attoparsec.Parser Content
parseChunk = Attoparsec.choice
  [ do s <- Attoparsec.takeWhile1 (/=questionMark) -- '?' question mark
       pure (String s)
  , Attoparsec.try $ do
      Attoparsec.word8 questionMark
      mode <- Attoparsec.takeWhile validChar
      Attoparsec.word8 questionMark
      name <- Attoparsec.takeWhile validChar
      Attoparsec.word8 questionMark
      case mode of
        "env" -> pure $ EnvVar name
        "" -> pure $ PromptVar name
        _ -> fail $ "Couldn't recognize mode: " <> bsToChars mode

    -- Allow for stand-alone question marks, like in the common ternary operator ? :
  , (String . Data.ByteString.singleton) <$> Attoparsec.word8 questionMark
  ]
  where
    questionMark = 63
    space = 32
    validChar c = c /= questionMark
               && c /= space


bsToChars :: ByteString -> [Char]
bsToChars = fmap (Data.Char.chr . fromIntegral) . Data.ByteString.unpack


charsToBs :: [Char] -> ByteString
charsToBs = Data.ByteString.pack . fmap (fromIntegral . Data.Char.ord)


parseBS :: ByteString -> Either GHC.Base.String [Content]
parseBS = Attoparsec.parseOnly (Attoparsec.many' parseChunk <* Attoparsec.endOfInput)


-- | Given a list of variables, that the user has already given a meaning to,
-- convert a list of 'Content's into a bytestring, by substituting the strings
-- given by the user and the content of environment variables for the 'Content' variables
-- and concatenating the resulting strings (without spaces, etc.).
convert :: [Content] -> StateT (HashMap ByteString ByteString) IO ByteString
convert con = do
  asked <- get
  bss <- forM con $ \c -> case c of
    String bs -> pure bs
    EnvVar var -> do
      menv <- lift $ System.Environment.lookupEnv (bsToChars var)
      case menv of
        Nothing -> lift $ throwIO $ CouldntFindEnvVar var
        Just str -> pure $ charsToBs str
    PromptVar var ->
      case HashMap.lookup var asked of
        Just res -> pure res
        Nothing -> do
          lift $ Data.ByteString.putStr $ "Please give a value for '" <> var <> "': "
          res <- lift Data.ByteString.getLine
          modify' (HashMap.insert var res)
          pure res
  pure (mconcat bss)


-- | Return all files in a directory.
-- > allFiles "/home/xyz"
-- [".zsh_rc", "Documents/CV.docx", ..]
allFiles :: FilePath -> IO [FilePath]
allFiles = flip go ""
  where
    go dir prefix = do
      content <- listDirectory dir
      dirs <- filterM (doesDirectoryExist . (</>) dir) content
      subfiles <- mconcat <$> traverse (\d -> go (dir </> d) (prefix </> d)) dirs
      let files = fmap (prefix </>) $ diff content dirs
      pure $ files <> subfiles

    -- Unlike \\, this works in O(n) time relative to the first list.
    diff (x:xs) (y:ys) | x == y = diff xs ys
    diff (x:xs) (y:ys) | x /= y = x : diff xs (y:ys)
    diff xs [] = xs
    diff [] ys = undefined


data TemplateExceptions
  = CouldntParseFilename ByteString GHC.Base.String -- ^ name and attoparsec info
  | CouldntParseFile ByteString GHC.Base.String -- ^ name and attoparsec info
  | CouldntFindEnvVar ByteString
  deriving (Eq, Show)

instance Exception TemplateExceptions where
  displayException (CouldntParseFilename name info) =
    "Couldn't parse filename '" <> bsToChars name <> "': \n" <> info
  displayException (CouldntParseFile name info) =
    "Couldn't parse file '" <> bsToChars name <> "': \n" <> info
  displayException (CouldntFindEnvVar var) =
    "Couldn't find the environment variable '" <> bsToChars var <> "'."


-- | Print the first argument and then the second,
-- and wait for 'j' or 'n' (spaces get trimmed, case-insensitive).
-- When the user enters something else, print the second argument
-- and wait for another input and so forth.
-- > askUser "This is bad." "Continue? [j/N]"
askUser :: ByteString -> ByteString -> IO Bool
askUser msg repeat = do
  Data.ByteString.Char8.putStrLn msg
  go
  where
    go = do
      Data.ByteString.Char8.putStr repeat
      r <- Data.ByteString.Char8.getLine
      let trimmed = fst $ Data.ByteString.Char8.spanEnd Data.Char.isSpace
                        $ Data.ByteString.Char8.dropWhile Data.Char.isSpace r
      let lower = Data.ByteString.Char8.map Data.Char.toLower trimmed
      case lower of
        "j" -> pure True
        "n" -> pure False
        _ -> go


main :: IO ()
main = do
  [name] <- getArgs
  templateDir <- (</> toList name) <$> getAppUserDataDirectory "templates"
  templateFiles <- allFiles templateDir

  -- Parse the filenames and resolve the variables in them.
  (destFiles, asked) <- runStateT
    (mapM (convert <=< parseFilename . charsToBs) templateFiles)
    HashMap.empty

  -- Check whether some files are already present.
  existingFiles <- filterM (doesFileExist . bsToChars) destFiles
  when (not $ null existingFiles) $ do
    overwrite <- askUser
      ("The following files already exist:\n"
      <> Data.ByteString.Char8.unlines (fmap ("  "<>) existingFiles)
      ) "Overwrite? [y/N]"
    when (not overwrite) $ do
      System.Exit.exitFailure

  -- Copy the file content.
  flip evalStateT asked
    $ forM_ (Data.List.zip (fmap (templateDir </>) templateFiles)
                           (fmap bsToChars destFiles))
    $ \(tf, df) -> do
      bs <- lift $ Data.ByteString.readFile tf
      cs <- parseFile df bs
      completed <- convert cs
      lift $ createDirectoryIfMissing True (dropFileName df)
      lift $ Data.ByteString.writeFile df completed

  where
    parseFilename bs = case parseBS bs of
      Right a -> pure a
      Left s -> lift $ throwIO $ CouldntParseFilename bs s

    parseFile name bs = case parseBS bs of
      Right a -> pure a
      Left s -> lift $ throwIO $ CouldntParseFile (Data.ByteString.Char8.pack name) s