
module ConfigFile (DCF.ConfigParser, open, maybeGet, getWithDefault, get, getBool, getList, getFile, getFolder, getFiles, getFolders, getMaybeFile) where

import Control.Applicative
import Control.Monad
import Data.List.Split
import Data.String.Utils
import System.Directory
import System.FilePath.Posix
import System.Path.NameManip
import Text.Regex.PCRE
import Debug.Trace
import qualified Data.ConfigFile as DCF

import Utility

handleCPError :: DCF.CPError -> Either String a
handleCPError e = case e of
  (DCF.ParseError msg, l) -> m l $ "Parse error: " ++ msg
  (DCF.SectionAlreadyExists sec, l) -> m l $ "Attempt to create an already-existing section: " ++ sec
  (DCF.NoSection sec, l) -> m l $ "The section does not exist: " ++ sec
  (DCF.NoOption opt, l) -> m l $ "The option does not exist: " ++ opt
  (DCF.OtherProblem msg, l) -> m l $ "Miscellaneous error: " ++ msg
  (DCF.InterpolationError msg, l) -> m l $ "Raised by interpolatingAccess if a request was made for a non-existant option: " ++ msg
 where
  m :: String -> String -> Either String a
  m l msg = Left $ "Config file at " ++ l ++ ": " ++ msg


open :: FilePath -> FilePath -> FilePath -> [(String, String)] -> EitherT String IO DCF.ConfigParser
open relative_target relative_public config flags = do
  public <- catchIO $ fmap dropTrailingPathSeparator $ 
    if '/' == relative_public !! 0 then return relative_public else do
      absolute_root <- getCurrentDirectory
      return $ unsplit_path (absolute_root, relative_public)
  exists <- catchIO $ doesFileExist config
  if exists then right () else do
    absolutePath <- catchIO $ absolute_path config
    throwT $ "Config file '" ++ absolutePath ++ "' wasn't found."
  let (name, extension) = splitExtensions relative_target
  if extension == ".js" then right () else do
    throwT $ "Target must end with '.js': '" ++ relative_target ++ "'"
  cp <- (EitherT $ DCF.readfile DCF.emptyCP config) `catchT` (hoistEither . handleCPError)
  foldr setter (right cp) $ [("public", public),
                             ("name", replace "/" "_" name),
                             ("target", unsplit_path (public, relative_target))] ++ flags
 where
  setter :: (String, String) -> EitherT String IO DCF.ConfigParser -> EitherT String IO DCF.ConfigParser
  setter (opt, val) eitherCp = do
    cp <- eitherCp
    hoistEither $ set cp "DEFAULT" opt val


dereferenceValue :: DCF.ConfigParser -> String -> Either String String
dereferenceValue cp rawV = do
  v <- linker cp rawV
  foldM replacer v [("${PUBLIC}", "public"), ("${NAME}", "name")]
 where
  linker :: DCF.ConfigParser -> String -> Either String String
  linker cp line = case line =~ "@{([^}]+)}" :: [[String]] of
    [match, name]:_ -> do
      link <- get cp "DEFAULT" name
      linker cp $ replace match link line
    _ -> return line
  replacer :: String -> (String, String) -> Either String String
  replacer val (x, y) = do
    replace x <$> (DCF.get cp "DEFAULT" y `catchE` handleCPError) <*> pure val


set :: DCF.ConfigParser -> String -> String -> String -> Either String DCF.ConfigParser
set cp sec opt val = DCF.set cp sec opt val `catchE` handleCPError

maybeGet :: DCF.ConfigParser -> String -> String -> Either String (Maybe String)
maybeGet cp sec opt = do
  element <- DCF.get cp sec opt `catchE` handleNotExists `catchE` handleCPError
  maybe (return Nothing) (fmap Just . dereferenceValue cp) element
 where
  handleNotExists :: DCF.CPError -> Either DCF.CPError (Maybe String)
  handleNotExists (DCF.NoSection _, _) = return Nothing
  handleNotExists (DCF.NoOption _, _) = return Nothing
  handleNotExists x = Left x -- this must be handled by handleCPError

getWithDefault :: String -> DCF.ConfigParser -> String -> String -> Either String String
getWithDefault def cp sec = fmap (fromMaybe def) . maybeGet cp sec

get :: DCF.ConfigParser -> String -> String -> Either String String
get cp sec opt = DCF.get cp sec opt `catchE` handleCPError >>= dereferenceValue cp


getBool :: DCF.ConfigParser -> String -> String -> Either String Bool
getBool cp sec = fmap ("1" ==) . get cp sec


getList :: DCF.ConfigParser -> String -> String -> Either String [String]
getList cp sec = fmap (splitWhen (=='\n')) . get cp sec

data FileType = File | Folder deriving (Eq, Show)

getFile :: DCF.ConfigParser -> String -> String -> EitherT String IO FilePath
getFile cp sec opt = validateExists File sec opt =<< (hoistEither $ get cp sec opt)

getFolder :: DCF.ConfigParser -> String -> String -> EitherT String IO FilePath
getFolder cp sec opt = validateExists Folder sec opt =<< (hoistEither $ get cp sec opt)

validateExists :: FileType -> String -> String -> FilePath -> EitherT String IO FilePath
validateExists t sec opt f = do
  exists <- catchIO $ (if File == t then doesFileExist else doesDirectoryExist) f
  if exists then return f else throwT msg
 where
  msg :: String
  msg = (show t) ++ " '" ++ f ++ "' at '" ++ sec ++ "/" ++ opt ++ "' doesn't exist or isn't a " ++ (show t) ++ "."

getFiles :: DCF.ConfigParser -> String -> String -> EitherT String IO [FilePath]
getFiles = validateMany File

getFolders :: DCF.ConfigParser -> String -> String -> EitherT String IO [FilePath]
getFolders = validateMany Folder

validateMany :: FileType -> DCF.ConfigParser -> String -> String -> EitherT String IO [FilePath]
validateMany t cp sec opt = validateEach =<< (hoistEither $ getList cp sec opt)
 where
  validateEach :: [FilePath] -> EitherT String IO [FilePath]
  validateEach = sequence . fmap (validateExists t sec opt)

getMaybeFile :: DCF.ConfigParser -> String -> String -> EitherT String IO FilePath
getMaybeFile cp sec opt = do
  file <- hoistEither $ get cp sec opt
  validateExists Folder sec opt (takeDirectory file)
  return file