{-# LANGUAGE CPP #-}

module HIndent.CabalFile
  ( getCabalExtensionsForSourcePath
  ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.List
import Data.Maybe
import Data.Traversable
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
#if MIN_VERSION_Cabal(2, 2, 0)
import Distribution.PackageDescription.Parsec
#else
import Distribution.PackageDescription.Parse
#endif
import Language.Haskell.Extension
import qualified Language.Haskell.Exts.Extension as HSE
import System.Directory
import System.FilePath
import Text.Read

data Stanza = MkStanza
  { _stanzaBuildInfo :: BuildInfo
  , stanzaIsSourceFilePath :: FilePath -> Bool
  }

-- | Find the relative path of a child path in a parent, if it is a child
toRelative :: FilePath -> FilePath -> Maybe FilePath
toRelative parent child = let
  rel = makeRelative parent child
  in if rel == child
       then Nothing
       else Just rel

-- | Create a Stanza from `BuildInfo` and names of modules and paths
mkStanza :: BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza bi mnames fpaths =
  MkStanza bi $ \path -> let
    modpaths = fmap toFilePath $ otherModules bi ++ mnames
    inDir dir =
      case toRelative dir path of
        Nothing -> False
        Just relpath ->
          any (equalFilePath $ dropExtension relpath) modpaths ||
          any (equalFilePath relpath) fpaths
    in any inDir $ hsSourceDirs bi

-- | Extract `Stanza`s from a package
packageStanzas :: PackageDescription -> [Stanza]
packageStanzas pd = let
  libStanza :: Library -> Stanza
  libStanza lib = mkStanza (libBuildInfo lib) (exposedModules lib) []
  exeStanza :: Executable -> Stanza
  exeStanza exe = mkStanza (buildInfo exe) [] [modulePath exe]
  testStanza :: TestSuite -> Stanza
  testStanza ts =
    mkStanza
      (testBuildInfo ts)
      (case testInterface ts of
         TestSuiteLibV09 _ mname -> [mname]
         _ -> [])
      (case testInterface ts of
         TestSuiteExeV10 _ path -> [path]
         _ -> [])
  benchStanza :: Benchmark -> Stanza
  benchStanza bn =
    mkStanza (benchmarkBuildInfo bn) [] $
    case benchmarkInterface bn of
      BenchmarkExeV10 _ path -> [path]
      _ -> []
  in mconcat
       [ maybeToList $ fmap libStanza $ library pd
       , fmap exeStanza $ executables pd
       , fmap testStanza $ testSuites pd
       , fmap benchStanza $ benchmarks pd
       ]

-- | Find cabal files that are "above" the source path
findCabalFiles :: FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles dir rel = do
  names <- getDirectoryContents dir
  cabalnames <-
    filterM (doesFileExist . (dir </>)) $ filter (isSuffixOf ".cabal") names
  case cabalnames of
    []
      | dir == "/" -> return Nothing
    [] -> findCabalFiles (takeDirectory dir) (takeFileName dir </> rel)
    _ -> return $ Just (fmap (\n -> dir </> n) cabalnames, rel)

getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription)
#if MIN_VERSION_Cabal(2, 2, 0)
getGenericPackageDescription cabalPath = do
    cabaltext <- BS.readFile cabalPath
    return $ parseGenericPackageDescriptionMaybe cabaltext
#else
getGenericPackageDescription cabalPath = do
  cabaltext <- readFile cabalPath
  case parsePackageDescription cabaltext of
    ParseOk _ gpd -> return $ Just gpd
    _             -> return Nothing
#endif

-- | Find the `Stanza` that refers to this source path
getCabalStanza :: FilePath -> IO (Maybe Stanza)
getCabalStanza srcpath = do
  abssrcpath <- canonicalizePath srcpath
  mcp <- findCabalFiles (takeDirectory abssrcpath) (takeFileName abssrcpath)
  case mcp of
    Just (cabalpaths, relpath) -> do
      stanzass <-
        for cabalpaths $ \cabalpath -> do
          genericPackageDescription <- getGenericPackageDescription cabalpath
          case genericPackageDescription of
            Nothing -> return []
            Just gpd -> do
              return $ packageStanzas $ flattenPackageDescription gpd
      return $
        case filter (\stanza -> stanzaIsSourceFilePath stanza relpath) $
             mconcat stanzass of
          [] -> Nothing
          (stanza:_) -> Just stanza -- just pick the first one
    Nothing -> return Nothing

-- | Get (Cabal package) language and extensions from the cabal file for this source path
getCabalExtensions :: FilePath -> IO (Language, [Extension])
getCabalExtensions srcpath = do
  mstanza <- getCabalStanza srcpath
  return $
    case mstanza of
      Nothing -> (Haskell98, [])
      Just (MkStanza bi _) -> do
        (fromMaybe Haskell98 $ defaultLanguage bi, defaultExtensions bi)

convertLanguage :: Language -> HSE.Language
convertLanguage lang = read $ show lang

convertKnownExtension :: KnownExtension -> Maybe HSE.KnownExtension
convertKnownExtension ext =
  case readEither $ show ext of
    Left _ -> Nothing
    Right hext -> Just hext

convertExtension :: Extension -> Maybe HSE.Extension
convertExtension (EnableExtension ke) =
  fmap HSE.EnableExtension $ convertKnownExtension ke
convertExtension (DisableExtension ke) =
  fmap HSE.DisableExtension $ convertKnownExtension ke
convertExtension (UnknownExtension s) = Just $ HSE.UnknownExtension s

-- | Get extensions from the cabal file for this source path
getCabalExtensionsForSourcePath :: FilePath -> IO [HSE.Extension]
getCabalExtensionsForSourcePath srcpath = do
  (lang, exts) <- getCabalExtensions srcpath
  return $
    fmap HSE.EnableExtension $
    HSE.toExtensionList (convertLanguage lang) $ mapMaybe convertExtension exts