{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contains Haskell variables representing globally visible 
-- names for files, paths, extensions and various other constants. 
-- Rather than have strings floating around the system, all constant names
-- should be defined here, and the (exported) variables should be used and
-- manipulated elsewhere.

module Language.Haskell.Liquid.FileNames (
  
  -- * Hardwired file extension names
    Ext (..)
  , extFileName
  , extModuleName
  , isExtFile
 
  -- * Hardwired global names 
  , dummyName
  , preludeName
  , boolConName
  , listConName
  , tupConName
  , propConName
  , vvName
  , symSepName

  -- * Hardwired paths 
  , getIncludePath, getFixpointPath, getCSSPath

  -- * Various generic utility functions for finding and removing files
  , getHsTargets
  , getFileInDirs
  , findFileInDirs
  , copyFiles, deleteBinFiles
  
) where

import qualified Control.Exception            as Ex
import           Control.Monad.State
import           Data.List                    hiding (find)
import           Data.Maybe                   (fromMaybe)
import           Language.Haskell.Liquid.Misc
import           System.Directory
import           System.Environment
import           System.FilePath
import           System.FilePath.Find

------------------------------------------------------------
-- | Hardwired Paths and Files -----------------------------
------------------------------------------------------------

envVarName = "LIQUIDHS"

getIncludePath, getCSSPath, getFixpointPath  ::  IO FilePath 

getIncludePath  = getSuffixPath ["include"]                                 >>= checkM doesDirectoryExist "include directory"
getCSSPath      = getSuffixPath ["syntax", "liquid.css"]                    >>= checkM doesFileExist      "css file"          
getFixpointPath = getSuffixPath ["external", "fixpoint", "fixpoint.native"] >>= checkM doesFileExist      "fixpoint binary"   


getSuffixPath ::  [FilePath] -> IO FilePath 
getSuffixPath suff 
  = (joinPath . (: suff)) `fmap` getEnv envVarName

checkM f msg p 
  = do ex <- f p
       if ex then return p else errorstar $ "Cannot find " ++ msg ++ " at :" ++ p

-- getIncludePath  = checkM doesDirectoryExist "include directory" =<< getSuffixPath ["include"]
-- getCSSPath      = checkM doesFileExist      "css file"          =<< getSuffixPath ["syntax", "hscolour.css"]
-- getFixpointPath = checkM doesFileExist      "fixpoint binary"   =<< getSuffixPath ["external", "fixpoint", "fixpoint.native"]

-- envPrefix  = "$" ++ envVarName ++ "/"
-- getIncludePath  = (</> "include") `fmap` getEnv envVarName
-- getFixpointPath ::  IO FilePath 
-- getFixpointPath = do p  <- getSuffixPath ["external", "fixpoint", "fixpoint.native"]
--                      ex <- doesFileExist p
--                      if ex then return p else err p
--                   where err p   = errorstar $ "Cannot find fixpoint executable at: " ++ p

-- checkExists msg p 
--   = do ex <- doesFileExist p
--        if ex then return p else err
--     where err = errorstar $ "Cannot find " ++ msg ++ " at :" ++ p


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

data Ext = Cgi    -- ^ Constraint Generation Information 
         | Fq     -- ^ Input to constraint solving (fixpoint)
         | Out    -- ^ Output from constraint solving (fixpoint)
         | Html   -- ^ HTML file with inferred type annotations 
         | Annot  -- ^ Text file with inferred types 
         | Hs     -- ^ Target source 
         | LHs    -- ^ Literate Haskell target source file
         | Spec   -- ^ Spec file (e.g. include/Prelude.spec) 
         | Hquals -- ^ Qualifiers file (e.g. include/Prelude.hquals)
         | Result -- ^ Final result: SAFE/UNSAFE
         | Cst    -- ^ I've totally forgotten!
         | Mkdn   -- ^ Markdown file (temporarily generated from .Lhs + annots) 
         | Pred   
         | PAss    
         | Dat    
         deriving (Eq, Ord, Show)

extMap e = go e
  where 
    go Cgi    = "cgi"
    go Pred   = "pred"
    go PAss   = "pass"
    go Dat    = "dat"
    go Out    = "fqout"
    go Fq     = "fq"
    go Html   = "html"
    go Cst    = "cst"
    go Annot  = "annot"
    go Hs     = "hs"
    go LHs    = "lhs"
    go Mkdn   = "markdown"
    go Spec   = "spec"
    go Hquals = "hquals" 
    go Result = "out"
    go _      = errorstar $ "extMap: Unknown extension" ++ show e


-- extMap   = M.fromList [ (Cgi,    "cgi")
--                       , (Pred,   "pred")
--                       , (PAss,   "pass")
--                       , (Dat,    "dat")
--                       , (Out,    "out")
--                       , (Fq,     "fq")
--                       , (Html,   "html")
--                       , (Cst,    "cst")
--                       , (Annot,  "annot")
--                       , (Hs,     "hs")
--                       , (LHs,    "lhs")
--                       , (Mkdn,   "md")
--                       , (Spec,   "spec")
--                       , (Hquals, "hquals") ]



-- repFileName     :: Ext -> FilePath -> FilePath
-- repFileName ext = extFileName ext . dropExtension 

extFileName     :: Ext -> FilePath -> FilePath
extFileName ext = (`addExtension` (extMap ext))

isExtFile ::  Ext -> FilePath -> Bool
isExtFile ext = ((extMap ext) `isSuffixOf`)

extModuleName ::  String -> Ext -> FilePath
extModuleName modName ext =
  case explode modName of
    [] -> errorstar $ "malformed module name: " ++ modName
    ws -> extFileName ext $ foldr1 (</>) ws
  where explode = words . map (\c -> if c == '.' then ' ' else c)

preludeName  :: String
preludeName  = "Prelude"

copyFiles :: [FilePath] -> FilePath -> IO ()
copyFiles srcs tgt
  = do Ex.catch (removeFile tgt) $ \(_ :: Ex.IOException) -> return ()
       forM_ srcs (readFile >=> appendFile tgt)

deleteBinFiles :: FilePath -> IO ()
deleteBinFiles fn = mapM_ (tryIgnore "delete binaries" . removeFile)
                  $ (fn `replaceExtension`) `fmap` exts
  where exts = ["hi", "o"]

-- resolvePath :: FilePath -> FilePath -> IO FilePath
-- resolvePath base path
--   = case stripPrefix envPrefix path of
--       Just path' -> liftM (</> path') getIncludePath
--       Nothing    -> return $ if isAbsolute path then path else base </> path

-- libName      :: String -> FilePath
-- libName ext  = envPrefix ++ "Prelude." ++ ext

-- existingFiles :: String -> [FilePath] -> IO [FilePath]
-- existingFiles = filterM . warnMissing

-- warnMissing s f
--   = do b <- doesFileExist f
--        unless b $ putStrLn $ printf "WARNING: missing file (%s): %s" s f
--        return b



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

getHsTargets p
  | hasTrailingPathSeparator p = getHsSourceFiles p
  | otherwise                  = return [p]

getHsSourceFiles = find dirs hs
  where hs   = extension ==? ".hs" ||? extension ==? ".lhs"
        dirs = liftM (not . ("dist" `isSuffixOf`)) directory

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


getFileInDirs :: FilePath -> [FilePath] -> IO (Maybe FilePath)
getFileInDirs name = findFirst (testM doesFileExist . (</> name))

findFileInDirs ::  FilePath -> [FilePath] -> IO FilePath
findFileInDirs file dirs
  = liftM (fromMaybe err) (findFirst (find always (fileName ==? file)) dirs)
    where err = errorstar $ "findFileInDirs: cannot find " ++ file ++ " in " ++ show dirs


----------------------------------------------------------------------------
--------------- Global Name Definitions ------------------------------------
----------------------------------------------------------------------------

dummyName   = "_LIQUID_dummy"
-- tagName     = "TAG"
boolConName = "Bool"
listConName = "List"
tupConName  = "Tuple"
propConName = "Prop"

vvName      = "VV"
symSepName  = '#'