{-# Language PatternGuards, CPP #-}

module CabalCargs.Spec
   ( Spec(..)
   , fromCmdArgs
   ) where

import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)
import Distribution.Parsec.Common (PWarning)
import qualified Distribution.System as Sys
import CabalCargs.Args (Args)
import qualified CabalCargs.Args as A
import qualified CabalCargs.Fields as F
import qualified CabalLenses as CL
import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Control.Monad.IO.Class
import Control.Lens
import System.Directory (getCurrentDirectory)
import qualified Filesystem.Path.CurrentOS as FP
import Filesystem.Path.CurrentOS ((</>))
import qualified Filesystem as FS
import Data.List ((\\))
import qualified Data.List as L
import Data.Maybe (isJust)
import qualified Data.ByteString as BS

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif


-- | Specifies which compiler args from which sections should be collected.
data Spec = Spec
   { sections      :: [CL.Section]              -- ^ the sections used for collecting the compiler args
   , fields        :: F.Fields                  -- ^ for these fields compiler args are collected
   , condVars      :: CL.CondVars               -- ^ used for the evaluation of the conditional fields in the cabal file
   , pkgDescrp     :: GenericPackageDescription -- ^ the package description of the read in cabal file
   , cabalFile     :: FilePath                  -- ^ the cabal file read from
   , distDir       :: Maybe FilePath            -- ^ the dist directory of the cabal build
   , packageDB     :: Maybe FilePath            -- ^ the directory of package database of the cabal sandbox
   , relativePaths :: Bool                      -- ^ if all returned paths are relative to the directory of the cabal file, otherwise all paths are absolute
   }


type Error = String

io :: MonadIO m => IO a -> m a
io = liftIO


-- | Create a 'Spec' by the command line arguments given to 'cabal-cargs'.
--
--   Depending on the command line arguments 'fromCmdArgs' might behave like
--   'fromCabalFile', if only a cabal file was given, like 'fromSourceFile',
--   if only a source file was given or like a mix of both, if a cabal file
--   and a source file have been given.
fromCmdArgs :: Args -> IO (Either Error Spec)
fromCmdArgs args
   | Just cabalFile <- A.cabalFile args = runExceptT $ do
      spec        <- fromCabalFile cabalFile
      srcSections <- io $ case A.sourceFile args of
                               Just srcFile -> findSections srcFile cabalFile (pkgDescrp spec)
                               _            -> return []

      return $ applyCondVars $ spec { sections      = combineSections (args, pkgDescrp spec) srcSections
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   | Just sourceFile <- A.sourceFile args = runExceptT $ do
      spec <- fromSourceFile sourceFile
      return $ applyCondVars $ spec { sections      = combineSections (args, pkgDescrp spec) (sections spec)
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   | otherwise = runExceptT $ do
      curDir    <- io getCurrentDirectory
      cabalFile <- CL.findCabalFile curDir
      spec      <- fromCabalFile cabalFile
      return $ applyCondVars $ spec { sections      = sections_ args (pkgDescrp spec)
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   where
      applyCondVars = applyFlags args . applyOS args . applyArch args



-- | Create a 'Spec' from the given cabal file.
--
--   If a cabal sandbox is present in the directory of the cabal file, then
--   the path to its package database is also returned.
fromCabalFile :: FilePath -> ExceptT Error IO Spec
fromCabalFile file = do
   pkgDescrp <- packageDescription file
   pkgDB     <- CL.findPackageDB file
   distDir   <- io $ CL.findDistDir file
   absFile   <- FP.encodeString <$> io (absoluteFile file)
   return $ Spec
      { sections      = CL.allSections pkgDescrp
      , fields        = F.allFields
      , condVars      = CL.fromDefaults pkgDescrp
      , pkgDescrp     = pkgDescrp
      , cabalFile     = absFile
      , distDir       = distDir
      , packageDB     = pkgDB
      , relativePaths = False
      }


-- | Create a 'Spec' from the given source file.
--
--   Starting at the directory of the source file a cabal file is searched
--   upwards the directory tree.
--
--   The found cabal file is searched for a fitting section for the source file.
--   If no fitting section could be found, then all sections are used.
--
--   If a cabal sandbox is present in the directory of the cabal file, then
--   the path to its package database is also returned.
fromSourceFile :: FilePath -> ExceptT Error IO Spec
fromSourceFile file = do
   cabalFile   <- CL.findCabalFile file
   pkgDB       <- CL.findPackageDB cabalFile
   distDir     <- io $ CL.findDistDir cabalFile
   pkgDescrp   <- packageDescription cabalFile
   srcSections <- io $ findSections file cabalFile pkgDescrp
   return $ Spec
      { sections      = srcSections
      , fields        = F.allFields
      , condVars      = CL.fromDefaults pkgDescrp
      , pkgDescrp     = pkgDescrp
      , cabalFile     = cabalFile
      , distDir       = distDir
      , packageDB     = pkgDB
      , relativePaths = False
      }


applyFlags :: Args -> Spec -> Spec
applyFlags args spec =
   spec { condVars = disableFlags . enableFlags $ condVars spec }
   where
      disableFlags condVars = foldr CL.disableFlag condVars (A.disable args)
      enableFlags  condVars = foldr CL.enableFlag condVars (A.enable args)


applyOS :: Args -> Spec -> Spec
applyOS (A.Args { A.os = os }) spec
   | Just str    <- os
   , [(name, _)] <- reads str :: [(Sys.OS, String)]
   = setOS name

   | Just str    <- os
   = setOS $ Sys.OtherOS str

   | otherwise
   = spec

   where
      setOS name = spec { condVars = (condVars spec) { CL.os = name } }


applyArch :: Args -> Spec -> Spec
applyArch (A.Args { A.arch = arch }) spec
   | Just str    <- arch
   , [(name, _)] <- reads str :: [(Sys.Arch, String)]
   = setArch name

   | Just str    <- arch
   = setArch $ Sys.OtherArch str

   | otherwise
   = spec

   where
      setArch name = spec { condVars = (condVars spec) { CL.arch = name } }


packageDescription :: FilePath -> ExceptT Error IO GenericPackageDescription
packageDescription file = do
   contents <- io $ BS.readFile file
   let (warnings, result) = runParseResult $ parseGenericPackageDescription contents
   io $ showWarnings warnings
   case result of
        Left (_, errors) -> throwE $ show errors
        Right pkgDescrp  -> return pkgDescrp

   where
      showWarnings :: [PWarning] -> IO ()
      showWarnings [] = return ()
      showWarnings ws = putStrLn $ "cabal-cargs: " ++ (L.intercalate ", " $ map show ws)


-- | Find matching sections in the package description for the given source file.
--   This is done by checking if the source file is contained in the directory
--   or a sub directory of the directories listed in the 'hs-source-dirs' field
--   of the section.
findSections :: FilePath -> FilePath -> GenericPackageDescription -> IO [CL.Section]
findSections srcFile cabalFile pkgDescrp = do
   absSrcFile <- absoluteFile srcFile
   cabalDir   <- absoluteDirectory cabalFile
   let sections = filter (fittingSection absSrcFile cabalDir) (allHsSourceDirs pkgDescrp)
   return $ map fst sections

   where
      fittingSection srcFile cabalDir (_, []) =
         isJust $ FP.stripPrefix (cabalDir </> FP.empty) srcFile

      fittingSection srcFile cabalDir (_, srcDirs) = any samePrefix srcDirs
         where samePrefix srcDir = isJust $ FP.stripPrefix (cabalDir </> srcDir </> FP.empty) srcFile


type HsSourceDirs = [FP.FilePath]
-- | Returns the hs-source-dirs of all sections present in the given package description.
allHsSourceDirs :: GenericPackageDescription -> [(CL.Section, HsSourceDirs)]
allHsSourceDirs pkgDescrp = zip sections hsSourceDirs
   where
      sections     = CL.allSections pkgDescrp
      hsSourceDirs = map (\section -> toFPs $ pkgDescrp ^. CL.buildInfoIf condVars section . CL.hsSourceDirsL) sections
         where
            toFPs    = map FP.decodeString
            condVars = CL.fromDefaults pkgDescrp


absoluteDirectory :: FilePath -> IO FP.FilePath
absoluteDirectory file = do
   absFile <- absoluteFile file
   isDir   <- FS.isDirectory absFile
   if isDir
      then return absFile
      else return . FP.directory $ absFile


absoluteFile :: FilePath -> IO FP.FilePath
absoluteFile = FS.canonicalizePath . FP.decodeString


combineSections :: (Args, GenericPackageDescription) -> [CL.Section] -> [CL.Section]
combineSections (args, pkgDescrp) sections
   | A.allSections args
   = CL.allSections pkgDescrp

   | [] <- explicitSections args
   , null sections
   = CL.allSections pkgDescrp

   | otherwise
   = L.nub $ explicitSections args ++ sections


-- | Convert the command line arguments into 'Fields'.
fields_ :: Args -> F.Fields
fields_ args
   | fs@(_:_) <- A.only args
   = fs

   | fs@(_:_) <- A.ignore args
   = F.allFields \\ fs

   | otherwise
   = F.allFields


-- | Convert the command line arguments into 'Sections'.
sections_ :: Args -> GenericPackageDescription -> [CL.Section]
sections_ args pkgDescrp
   | A.allSections args
   = CL.allSections pkgDescrp

   | ss@(_:_) <- explicitSections args
   = ss

   | otherwise
   = CL.allSections pkgDescrp


explicitSections :: Args -> [CL.Section]
explicitSections args =
   concat [ [CL.Library | A.library args]
          , map CL.Executable (A.executable args)
          , map CL.TestSuite (A.testSuite args)
          , map CL.Benchmark (A.benchmark args)
          ]