module MicroCabal.Main where
import Control.Monad
import Data.List
import Data.Maybe
import Data.Version
import System.Environment
import System.Exit
import System.Directory
import qualified System.Info as I
--import Text.Read
import MicroCabal.Backend.GHC
import MicroCabal.Backend.MHS
import MicroCabal.Cabal
import MicroCabal.Env
import MicroCabal.Glob
import MicroCabal.Normalize
import MicroCabal.Parse
import MicroCabal.StackageList
import MicroCabal.Unix
--import MicroCabal.YAML

version :: String
version = "MicroCabal 0.3.1.0"

main :: IO ()
main = do
  (env, args) <- decodeCommonArgs =<< setupEnv

  case args of
    [] -> usage
    ["--version"]  -> putStrLn version
    "build"   : as -> cmdBuild   env as
    "clean"   : as -> cmdClean   env as
    "fetch"   : as -> cmdFetch   env as
    "help"    : as -> cmdHelp    env as
    "install" : as -> cmdInstall env as
    "parse"   : as -> cmdParse   env as
    "update"  : as -> cmdUpdate  env as
    _ -> usage

setupEnv :: IO Env
setupEnv = do
  cdirm <- lookupEnv "CABALDIR"
  home <- getEnv "HOME"
  let cdir = fromMaybe (home </> ".mcabal") cdirm
      env = Env{ cabalDir = cdir, distDir = "dist-mcabal", verbose = 0, depth = 0,
                 backend = undefined, recursive = False, targets = [TgtLib, TgtExe] }
  be <- mhsBackend env
  return env{ backend = be }

decodeCommonArgs :: Env -> IO (Env, [String])
decodeCommonArgs env = do
  let loop e ("-v"    : as) = loop e{ verbose = verbose e + 1 } as
      loop e ("-q"    : as) = loop e{ verbose = -1 } as
      loop e ("-r"    : as) = loop e{ recursive = True } as
      loop e ("--ghc" : as) = do be <- ghcBackend env; loop e{ backend = be } as
      loop e ("--mhs" : as) = do be <- mhsBackend env; loop e{ backend = be } as
      loop e as = return (e, as)
  loop env =<< getArgs

usage :: IO ()
usage = do
  env <- setupEnv
  cmdHelp env []
  exitWith (ExitFailure 1)

-----------------------------------------

-- Package list
packageListName :: FilePath
packageListName = "packages.txt"

-- Local name for snapshot list
snapshotsName :: FilePath
snapshotsName = "snapshots.json"

-- Local name for snapshot
snapshotName :: FilePath
snapshotName = "snapshot.yaml"

-- Name of the nightly snapshot
nightlyName :: String
nightlyName = "nightly"

-- This is a JSON document enumerating all releases.
stackageSourceList :: URL
stackageSourceList = URL "https://stackage-haddock.haskell.org/snapshots.json"

-- prefix of URL for actual snapshot
snapshotSource :: String
snapshotSource = "https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/" -- lts/22/13.yaml

-- XXX This needs improvement
getBestStackage :: Env -> IO URL
getBestStackage env = do
  -- Get source list
  let dir = cabalDir env
      fsnaps = dir </> snapshotsName
  wget env stackageSourceList fsnaps
  file <- readFile fsnaps
  let snaps = parseSnapshots fsnaps file
{-
      -- Pick LTS snapshot
      snap = snd $ last $
             [(0::Int, error "no lts snapshots found")] ++
             sort [ (l, r) | (lp, r) <- snaps, Just l <- [stripPrefix "lts-" lp >>= readMaybe] ]
      snap' = map (\ c -> if c == '-' || c == '.' then '/' else c) snap
      snapURL = URL $ snapshotSource ++ snap' ++ ".yaml"
-}
      -- Pick a nightly snapshot
      snap = fromMaybe (error "no nightly snapshot found") $ lookup nightlyName snaps
      snap' = fixLeading0 $ map (\ c -> if c == '-' then '/' else c) snap
      fixLeading0 ('/':'0':cs) = '/' : fixLeading0 cs
      fixLeading0 (c:cs) = c : fixLeading0 cs
      fixLeading0 cs = cs
      snapURL = URL $ snapshotSource ++ snap' ++ ".yaml"
  message env 1 $ "Picking Stackage snapshot " ++ snap
  return $ snapURL

cmdUpdate :: Env -> [String] -> IO ()
cmdUpdate env [] = do
  message env 0 "Retrieving Stackage package list"
  let dir = cabalDir env
      stk = dir </> snapshotName
      fpkgs = dir </> packageListName
  mkdir env dir
  url <- getBestStackage env
  wget env url stk
  file <- readFile stk
  let yml = parseYAML stk file
      pkgs = yamlToStackageList yml
      ghcVersion = yamlToGHCVersion yml
--  putStrLn $ "==== " ++ ghcVersion
--  putStrLn $ showYAML yml
--  putStrLn $ show pkgs
  message env 1 $ "Write package list to " ++ fpkgs
  writeFile fpkgs $ unlines $ map showPackage $ pkgs ++ distPkgs
  writeFile (dir </> "ghc-version") ghcVersion
cmdUpdate _ _ = usage

-- These packages are part of the ghc distribution, so they are
-- not in the stackage list.
-- XXX What to do about versions?
-- XXX more...
distPkgs :: [StackagePackage]
distPkgs =
  [ StackagePackage "containers" (makeVersion [0,6,8])    False []
  , StackagePackage "deepseq"    (makeVersion [1,5,0,0])  False []
  , StackagePackage "mtl"        (makeVersion [2,3,1])    False []
  , StackagePackage "time"       (makeVersion [1,12,2])   False []
  ]

-----------------------------------------

hackageSrcURL :: String
hackageSrcURL = "https://hackage.haskell.org/package/"

getPackageList :: Env -> IO [StackagePackage]
getPackageList env = do
  let dir = cabalDir env
      fpkgs = dir </> packageListName
  b <- doesFileExist fpkgs
  when (not b) $ do
    message env 0 "No package list, running 'update' command"
    cmdUpdate env []
  map readPackage . lines <$> readFile fpkgs

getPackageInfo :: Env -> PackageName -> IO StackagePackage
getPackageInfo env pkg = do
  pkgs <- getPackageList env
  return $ fromMaybe (error $ "getPackageInfo: no package " ++ pkg) $ listToMaybe $ filter ((== pkg) . stName) pkgs

dirPackage :: Env -> FilePath
dirPackage env = cabalDir env </> "packages"

dirForPackage :: Env -> StackagePackage -> FilePath
dirForPackage env st = dirPackage env </> stName st ++ "-" ++ showVersion (stVersion st)

cmdFetch :: Env -> [String] -> IO ()
cmdFetch env [pkg] = do
  st <- getPackageInfo env pkg
  let pkgs = stName st ++ "-" ++ showVersion (stVersion st)
      url  = URL $ hackageSrcURL ++ pkgs </> pkgz
      pkgz = pkgs ++ ".tar.gz"
      pdir = dirForPackage env st
      file = pdir ++ ".tar.gz"
  b <- doesDirectoryExist pdir
  if b then
    message env 1 $ "Already in " ++ pdir
   else do
    mkdir env pdir
    message env 1 $ "Fetching  " ++ pkgz
    wget env url file
    message env 1 $ "Unpacking " ++ pkgz ++ " in " ++ pdir
    tarx env (dirPackage env) file
cmdFetch _ _ = usage

-----------------------------------------

findCabalFile :: Env -> IO FilePath
findCabalFile _env = do
  ns <- listDirectory "."
  case filter (".cabal" `isSuffixOf`) ns of
    []  -> error "no PKG.cabal file"
    [n] -> return n
    _   -> error "multiple PKG.cabal file"

cmdBuild :: Env -> [String] -> IO ()
cmdBuild env [] = build env
cmdBuild env [pkg] = do
  message env 0 $ "Build package " ++ pkg
  st <- getPackageInfo env pkg
  let dir = dirForPackage env st
  b <- doesDirectoryExist dir
  when (not b) $ do
    message env 0 $ "Package not found, running 'fetch " ++ pkg ++ "'"
    cmdFetch env [pkg]
  message env 0 $ "Building in " ++ dir
  setCurrentDirectory dir
  cmdBuild env []
cmdBuild _ _ = usage

getGlobal :: Cabal -> Section
getGlobal (Cabal sects) =
  fromMaybe (error "no global section") $ listToMaybe [ s | s@(Section "global" _ _) <- sects ]

makeDataPrefix :: Env -> Section -> Section -> FilePath
makeDataPrefix env (Section _ _ glob) (Section _ name _) = 
  let vers = getVersion glob "version"
      pkgVers = name ++ "-" ++ showVersion vers
      dataPrefix = cabalDir env </> compiler (backend env) </> "data" </> pkgVers
  in  dataPrefix

createPathFile :: Env -> Section -> Section -> IO ()
createPathFile env gsect@(Section _ _ glob) sect = do
  let vers = getVersion glob "version"
      name = getFieldString glob "name"
      mdlName = "Paths_" ++ map (\ c -> if c == '-' then '_' else c) name
      pathName = pathModuleDir env </> mdlName ++ ".hs"
      dataPrefix = makeDataPrefix env gsect sect
      dataDir = dataPrefix </> "data"
  message env 1 $ "Creating path module " ++ pathName
  mkdir env (pathModuleDir env)
  writeFile pathName $
    "module " ++ mdlName ++ " where\n" ++
    "import Data.Version\n" ++
    "version :: Version; version = makeVersion " ++ show (versionBranch vers) ++ "\n" ++
    "getDataDir :: IO FilePath; getDataDir = return " ++ show dataDir ++ "\n"

build :: Env -> IO ()
build env = do
  fn <- findCabalFile env
  rfile <- readFile fn
  let comp = backendNameVers (backend env)
  let cbl = parseCabal fn rfile
      info = FlagInfo { os = I.os, arch = I.arch, flags = [], impl = comp }
      ncbl@(Cabal sects) = normalize info cbl
      glob = getGlobal ncbl
      sect s@(Section "executable" _ _) | TgtExe `elem` targets env = buildExe env glob s
      sect s@(Section "library"    _ _) | TgtLib `elem` targets env = buildLib env glob s
      sect _ = return ()
  message env 2 $ "Normalized Cabal file:\n" ++ show ncbl
  mapM_ sect $ addMissing sects

buildExe :: Env -> Section -> Section -> IO ()
buildExe env glob sect@(Section _ name flds) = do
  message env 0 $ "Building executable " ++ name
  createPathFile env glob sect
  let deps = getBuildDepends flds
      pkgs = [ p | (p, _, _) <- deps ]
  mapM_ (checkDep env) pkgs
  buildPkgExe (backend env) env glob sect

buildLib :: Env -> Section -> Section -> IO ()
buildLib env glob sect@(Section _ name flds) = do
  message env 0 $ "Building library " ++ name
  createPathFile env glob sect
  let pkgs = getBuildDependsPkg flds
  mapM_ (checkDep env) pkgs
  buildPkgLib (backend env) env glob sect

checkDep :: Env -> PackageName -> IO ()
checkDep env pkg = do
  let bend = backend env
  b <- doesPkgExist bend env pkg
  when (not b) $
    if recursive env then do
      let env' = env { depth = depth env + 1 }
      preserveCurrentDirectory $
        cmdInstallLib env' [pkg]
    else
      error $ "dependency not installed: " ++ pkg

-- If there is no section, except the global one, then just make a
-- library section.
addMissing :: [Section] -> [Section]
addMissing [glb@(Section "global" _ flds)] = [glb, Section "library" (getFieldString flds "name") flds]
addMissing sects = sects

-----------------------------------------

cmdInstall :: Env -> [String] -> IO ()
cmdInstall env args = do
  -- The will build and change current directory
  cmdBuild env args
  install env

cmdInstallLib :: Env -> [String] -> IO ()
cmdInstallLib env args = cmdInstall env{ targets = [TgtLib] } args

install :: Env -> IO ()
install env = do
  fn <- findCabalFile env
  rfile <- readFile fn
  let comp = backendNameVers (backend env)
  let cbl = parseCabal fn rfile
      info = FlagInfo { os = I.os, arch = I.arch, flags = [], impl = comp }
      ncbl@(Cabal sects) = normalize info cbl
      glob = getGlobal ncbl
      sect s@(Section "executable" _ _) | TgtExe `elem` targets env = installExe env glob s
      sect s@(Section "library"    _ _) | TgtLib `elem` targets env = installLib env glob s
      sect _ = return ()
  message env 2 $ "Normalized Cabal file:\n" ++ show ncbl
  mapM_ sect $ addMissing sects

installExe :: Env -> Section -> Section -> IO ()
installExe env glob sect@(Section _ name _) = do
  message env 0 $ "Installing executable " ++ name
  installDataFiles env glob sect
  installIncludeFiles env glob sect
  installCFiles env glob sect
  installPkgExe (backend env) env glob sect

installLib :: Env -> Section -> Section -> IO ()
installLib env glob sect@(Section _ name _) = do
  message env 0 $ "Installing library " ++ name
  installDataFiles env glob sect
  installIncludeFiles env glob sect
  installCFiles env glob sect
  installPkgLib (backend env) env glob sect

installDataFiles :: Env -> Section -> Section -> IO ()
installDataFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do
  let gdatas = getFieldStrings gflds [] "data-files"
      datas  = getFieldStrings  flds [] "data-files"
      dataPrefix = makeDataPrefix env glob sect
      dataDir  = dataPrefix </> "data"
  --print ("installDataFiles", gdatas ++ datas, dataDir)
  case gdatas ++ datas of
    [] -> return ()
    pats -> do
      files <- matchFiles "." pats
      message env 1 $ "Installing data files " ++ unwords files
      mkdir env dataDir
      copyFiles env "." files dataDir

installIncludeFiles :: Env -> Section -> Section -> IO ()
installIncludeFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do
  let gincs = getFieldStrings gflds [] "install-includes"
      incs  = getFieldStrings  flds [] "install-includes"
      dataPrefix = makeDataPrefix env glob sect
      incDir  = dataPrefix </> "include"
  case gincs ++ incs of
    [] -> return ()
    pats -> do
      let inc = head $ getFieldStrings flds ["."] "include-dirs"
      files <- matchFiles inc pats
      -- print (pats, files)
      message env 1 $ "Installing include files " ++ unwords files
      mkdir env incDir
      copyFiles env inc files incDir

installCFiles :: Env -> Section -> Section -> IO ()
installCFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do
  let gcs = getFieldStrings gflds [] "c-sources"
      cs  = getFieldStrings  flds [] "c-sources"
      dataPrefix = makeDataPrefix env glob sect
      cDir  = dataPrefix </> "cbits"
  case gcs ++ cs of
    [] -> return ()
    files -> do
      message env 1 $ "Installing C files " ++ unwords files
      mkdir env cDir
      mapM_ (\ f -> cp env f cDir) files

-----------------------------------------

cmdHelp :: Env -> [String] -> IO ()
cmdHelp _ _ = putStrLn "\
  \Available commands:\n\
  \  mcabal [FLAGS] build [PKG]    build in current directory, or the package PKG\n\
  \  mcabal [FLAGS] clean          clean in the current directory\n\
  \  mcabal [FLAGS] fetch PKG      fetch files for package PKG\n\
  \  mcabal [FLAGS] help           show this message\n\
  \  mcabal [FLAGS] install        build and install in current directory\n\
  \  mcabal [FLAGS] parse FILE     just parse a Cabal file (for debugging)\n\
  \  mcabal [FLAGS] update         retrieve new set of consistent packages\n\
  \\n\
  \Flags:\n\
  \  --version                     show version\n\
  \  -v                            be more verbose (can be repeated)\n\
  \  -q                            be quiet\n\
  \  -r                            do recursive installs for missing packages\n\
  \  --ghc                         compile using ghc\n\
  \  --mhs                         compile using mhs (default)\n\
  \\n\
  \Installs go to $CABALDIR if set, otherwise $HOME/.mcabal.\n\
  \"

-----------------------------------------

cmdClean :: Env -> [String] -> IO ()
cmdClean env _ = rmrf env (distDir env)

-----------------------------------------

cmdParse :: Env -> [String] -> IO ()
cmdParse env [fn] = do
  rfile <- readFile fn
  let comp = backendNameVers (backend env)
  let cbl = parseCabal fn rfile
      info = FlagInfo { os = I.os, arch = I.arch, flags = [], impl = comp }
      ncbl = normalize info cbl
  --putStrLn $ showCabal cbl
  putStrLn $ showCabal ncbl
cmdParse _ _ = undefined