yavie-0.0.1: src/MainNoPaths.hs

module MainNoPaths ( main, getYavieDir ) where

import System.Environment      ( getArgs )
import System.Directory        ( getCurrentDirectory,
                                 setCurrentDirectory, getModificationTime,
                                 getHomeDirectory, doesFileExist,
                                 getDirectoryContents )
import System.Cmd              ( rawSystem )
import System.Exit             ( exitWith )
import Control.Monad           ( when )
import Distribution.Simple     ( defaultMainArgs )
import System.Console.GetOpt   ( getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..) )

yavieDirName :: String
yavieDirName = ".yavie"

getYavieDir :: IO String
getYavieDir = fmap (++ '/' : yavieDirName) getHomeDirectory

getMainName :: FilePath -> IO ( String, [ String ] )
getMainName yavieDir = do
  args <- getArgs
  let ( opts, otherArgs, _err ) = getOpt Permute optDescrs args
  name <- getMainIsFromOptions yavieDir opts
  return ( name, otherArgs )
  
getMainIsFromOptions :: FilePath -> [ CmdLnOption ] -> IO String
getMainIsFromOptions yavieDir opts =
  case filter isMainIs opts of
       [ ]            -> fmap ( head . lines ) $ readFile ( yavieDir ++ "/default" )
       MainIs mn : _  -> return mn
       OptVersion : _ -> error "not occur"

data CmdLnOption = MainIs { _mainName :: String } | OptVersion
  deriving Show
isMainIs :: CmdLnOption -> Bool
isMainIs MainIs { } = True
isMainIs _          = False

optDescrs :: [ OptDescr CmdLnOption ]
optDescrs = [ optDescrMainIs, optDescrVersion ]

optDescrMainIs, optDescrVersion :: OptDescr CmdLnOption
optDescrMainIs  = Option "" [ "mainIs"  ] ( ReqArg MainIs ""  ) ""
optDescrVersion = Option "" [ "version" ] ( NoArg  OptVersion ) ""

main :: IO ()
main = do
  yavieDir <- getYavieDir
  ( mn, args ) <- getMainName yavieDir
  buildByCabal mn $ yavieDir ++ "/" ++ mn
  es <- rawSystem ( yavieDir ++ "/" ++ mn ++ "/bin/yavie-" ++ mn ) args
  exitWith es

buildByCabal :: String -> FilePath -> IO ()
buildByCabal mn sd = do
  update <- anythingNew ( sd ++ "/bin/yavie-" ++ mn ) sd
  when update $ do
    cd <- getCurrentDirectory
    setCurrentDirectory sd
    defaultMainArgs [ "configure", "--prefix=" ++ sd ]
    defaultMainArgs [ "build" ]
    defaultMainArgs [ "install" ]
    setCurrentDirectory cd

anythingNew :: FilePath -> FilePath -> IO Bool
anythingNew fn dn = do
  ext  <- doesFileExist fn
  if not ext then return True else do
    fmt  <- getModificationTime fn
    fps  <- getDirectoryContentsPath dn
    fmts <- mapM getModificationTime fps
    return $ any (> fmt) fmts
  
getDirectoryContentsPath :: FilePath -> IO [ FilePath ]
getDirectoryContentsPath dp = do
  fns <- getDirectoryContents dp
  return $ map (( dp ++ "/" ) ++) fns