-- |
-- Module      : Debian.Package.Build.Cabal
-- Copyright   : 2014-2015 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- This module wraps cabal library interfaces to keep sparse dependency to it.
module Debian.Package.Build.Cabal
       ( findDescriptionFile
       , fillSetupHs

       , setupCmd, clean, sdist
       , configure, build, install, register
       )  where

import Control.Applicative ((<$>))
import Control.Monad (filterM, when)
import Control.Monad.Trans.Class (lift)
import Data.Maybe (listToMaybe, isJust)
import Data.List (isSuffixOf)
import System.FilePath ((</>))
import System.Directory (getDirectoryContents, doesFileExist)

import Debian.Package.Build.Monad (Trace)
import Debian.Package.Build.Command (rawSystem')


-- | Find .cabal file
findDescriptionFile :: FilePath -> IO (Maybe FilePath)
findDescriptionFile :: FilePath -> IO (Maybe FilePath)
findDescriptionFile FilePath
dir = do
  [FilePath]
fs  <-  FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
  let find :: FilePath -> IO Bool
find FilePath
f
        | FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
suf  Bool -> Bool -> Bool
&&
          FilePath
suf FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
f           =  FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
f
        | Bool
otherwise                    =  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        where suf :: FilePath
suf = FilePath
".cabal"
  (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) (Maybe FilePath -> Maybe FilePath)
-> ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
find [FilePath]
fs

findSetupHs :: FilePath -> IO (Maybe FilePath)
findSetupHs :: FilePath -> IO (Maybe FilePath)
findSetupHs FilePath
dir =
  [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>)) [FilePath
"Setup.hs", FilePath
"Setup.lhs"]

fillSetupHs :: FilePath -> IO ()
fillSetupHs :: FilePath -> IO ()
fillSetupHs FilePath
dir = do
  Bool
found <- Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
findSetupHs FilePath
dir
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
found) (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
writeFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"Setup.hs") (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
    [FilePath] -> FilePath
unlines [FilePath
"import Distribution.Simple", FilePath
"main = defaultMain"]

setup :: [String] -> Trace ()
setup :: [FilePath] -> Trace ()
setup [FilePath]
args = do
  FilePath
setupHs  <-  FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Setup.hs or Setup.lhs is not found.") FilePath -> FilePath
forall a. a -> a
id (Maybe FilePath -> FilePath)
-> ReaderT Bool IO (Maybe FilePath) -> ReaderT Bool IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath) -> ReaderT Bool IO (Maybe FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> IO (Maybe FilePath)
findSetupHs FilePath
".")
  FilePath -> [FilePath] -> Trace ()
rawSystem' FilePath
"runghc" ([FilePath] -> Trace ()) -> [FilePath] -> Trace ()
forall a b. (a -> b) -> a -> b
$ FilePath
setupHs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args

-- | Call cabal library defaultMain like Setup.hs
setupCmd :: String -> [String] -> Trace ()
setupCmd :: FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
cmd = [FilePath] -> Trace ()
setup ([FilePath] -> Trace ())
-> ([FilePath] -> [FilePath]) -> [FilePath] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
cmd FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: )

-- | Cabal library defaultMain with sub-command clean
clean :: [String] -> Trace ()
clean :: [FilePath] -> Trace ()
clean =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"clean"

-- | Cabal library defaultMain with sub-command configure
configure :: [String] -> Trace ()
configure :: [FilePath] -> Trace ()
configure =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"configure"

-- | Cabal library defaultMain with sub-command sdist
sdist :: [String] -> Trace ()
sdist :: [FilePath] -> Trace ()
sdist =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"sdist"

-- | Cabal library defaultMain with sub-command build
build :: [String] -> Trace ()
build :: [FilePath] -> Trace ()
build =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"build"

-- | Cabal library defaultMain with sub-command install
install :: [String] -> Trace ()
install :: [FilePath] -> Trace ()
install =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"install"

-- | Cabal library defaultMain with sub-command register
register :: [String] -> Trace ()
register :: [FilePath] -> Trace ()
register =  FilePath -> [FilePath] -> Trace ()
setupCmd FilePath
"register"