{-|
Module      : Idris.Imports
Description : Code to handle import declarations.

License     : BSD3
Maintainer  : The Idris Community.
-}
module Idris.Imports(
    IFileType(..), findIBC, findImport, findInPath, findPkgIndex
  , ibcPathNoFallback, installedPackages, pkgIndex
  , PkgName, pkgName, unPkgName, unInitializedPkgName
  ) where

import Idris.AbsSyntax
import Idris.Core.TT
import Idris.Error
import IRTS.System (getIdrisLibDir)

import Control.Monad
import Control.Monad.State.Strict
import Data.Char (isAlpha, isDigit, toLower)
import Data.List (isSuffixOf)
import System.Directory
import System.FilePath

data IFileType = IDR FilePath | LIDR FilePath | IBC FilePath IFileType
    deriving (Show, Ord)

instance Eq IFileType where
    IDR x == IDR y = x == y
    LIDR x == LIDR y = x == y
    IBC x _ == IBC y _ = x == y
    _ == _ = False

newtype PkgName = PkgName String

unPkgName :: PkgName -> String
unPkgName (PkgName s) = map toLower s

instance Show PkgName where
    show (PkgName pkg) = pkg
instance Eq PkgName where
    a == b = unPkgName a == unPkgName b

unInitializedPkgName :: PkgName
unInitializedPkgName = PkgName ""

pkgName :: String -> Either String PkgName
pkgName ""      = Left "empty package name"
pkgName s@(f:l)
    | not $ isAlpha f =
        Left "package name need to start by a letter"
    | not $ all (\c -> isAlpha c || isDigit c || c `elem` "-_") l =
        Left "package name need to contain only letter, digits, and -_"
    | otherwise = Right $ PkgName s

-- | Get the index file name for a package name
pkgIndex :: PkgName -> FilePath
pkgIndex s = "00" ++ unPkgName s ++ "-idx.ibc"

srcPath :: FilePath -> FilePath
srcPath fp = let (_, ext) = splitExtension fp in
                 case ext of
                    ".idr" -> fp
                    _ -> fp ++ ".idr"

lsrcPath :: FilePath -> FilePath
lsrcPath fp = let (_, ext) = splitExtension fp in
                  case ext of
                     ".lidr" -> fp
                     _ -> fp ++ ".lidr"

-- Get name of byte compiled version of an import
ibcPath :: FilePath -> Bool -> FilePath -> FilePath
ibcPath ibcsd use_ibcsd fp = let (d_fp, n_fp) = splitFileName fp
                                 d = if (not use_ibcsd) || ibcsd == ""
                                     then d_fp
                                     else ibcsd </> d_fp
                                 n = dropExtension n_fp
                             in d </> n <.> "ibc"

ibcPathWithFallback :: FilePath -> FilePath -> IO FilePath
ibcPathWithFallback ibcsd fp = do let ibcp = ibcPath ibcsd True fp
                                  ibc <- doesFileExist' ibcp
                                  return (if ibc
                                          then ibcp
                                          else ibcPath ibcsd False fp)

ibcPathNoFallback :: FilePath -> FilePath -> FilePath
ibcPathNoFallback ibcsd fp = ibcPath ibcsd True fp

findImport :: [FilePath] -> FilePath -> FilePath -> Idris IFileType
findImport []     ibcsd fp = ierror . Msg $ "Can't find import " ++ fp
findImport (d:ds) ibcsd fp = do let fp_full = d </> fp
                                ibcp <- runIO $ ibcPathWithFallback ibcsd fp_full
                                let idrp = srcPath fp_full
                                let lidrp = lsrcPath fp_full
                                ibc <- runIO $ doesFileExist' ibcp
                                idr  <- runIO $ doesFileExist' idrp
                                lidr <- runIO $ doesFileExist' lidrp
                                let isrc = if lidr
                                           then LIDR lidrp
                                           else IDR idrp
                                if ibc
                                  then return (IBC ibcp isrc)
                                  else if (idr || lidr)
                                       then return isrc
                                       else findImport ds ibcsd fp

-- Only look for IBCs and not source
findIBC :: [FilePath] -> FilePath -> FilePath -> Idris (Maybe FilePath)
findIBC [] _ fp = return Nothing
findIBC (d:ds) ibcsd fp = do let fp_full = d </> fp
                             ibcp <- runIO $ ibcPathWithFallback ibcsd fp_full
                             ibc <- runIO $ doesFileExist' ibcp
                             if ibc
                                then return $ Just ibcp
                                else findIBC ds ibcsd fp


-- find a specific filename somewhere in a path

findInPath :: [FilePath] -> FilePath -> IO FilePath
findInPath [] fp = fail $ "Can't find file " ++ fp
findInPath (d:ds) fp = do let p = d </> fp
                          e <- doesFileExist' p
                          if e then return p else findInPath ds fp

findPkgIndex :: PkgName -> Idris FilePath
findPkgIndex p = do let idx = pkgIndex p
                    ids <- allImportDirs
                    runIO $ findInPath ids idx


installedPackages :: IO [String]
installedPackages = do
  idir <- getIdrisLibDir
  filterM (goodDir idir) =<< dirContents idir
  where
  allFilesInDir base fp = do
    let fullpath = base </> fp
    isDir <- doesDirectoryExist' fullpath
    if isDir
      then fmap concat (mapM (allFilesInDir fullpath) =<< dirContents fullpath)
      else return [fp]
  dirContents = fmap (filter (not . (`elem` [".", ".."]))) . getDirectoryContents
  goodDir idir d = any (".ibc" `isSuffixOf`) <$> allFilesInDir idir d


-- | Case sensitive file existence check for Mac OS X.
doesFileExist' :: FilePath -> IO Bool
doesFileExist' = caseSensitive doesFileExist

-- | Case sensitive directory existence check for Mac OS X.
doesDirectoryExist' :: FilePath -> IO Bool
doesDirectoryExist' = caseSensitive doesDirectoryExist

caseSensitive :: (FilePath -> IO Bool) -> FilePath -> IO Bool
caseSensitive existsCheck name =
  do exists <- existsCheck name
     if exists
        then do contents <- getDirectoryContents (takeDirectory name)
                return $ (takeFileName name) `elem` contents
        else return False
