module Debian.Debianize.Types.Atoms
where
import Control.Applicative ((<$>))
import Control.Category ((.))
import Control.Monad.State (StateT)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Generics (Data, Typeable)
import Data.Lens.Lazy (Lens, lens, (%=))
import Data.Map as Map (Map)
import Data.Monoid (Monoid(..))
import Data.Set as Set (Set, singleton, insert)
import Data.Text (Text)
import Debian.Changes (ChangeLog)
import qualified Debian.Debianize.Types.SourceDebDescription as S
import Debian.Debianize.VersionSplits (VersionSplits)
import Debian.Orphans ()
import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat)
import Debian.Relation (BinPkgName, Relations, SrcPkgName)
import Debian.Version (DebianVersion)
import Distribution.Compiler (CompilerFlavor(GHC))
import Distribution.License (License)
import Distribution.Package (PackageName)
import Distribution.PackageDescription as Cabal (FlagName, PackageDescription)
import Prelude hiding (init, init, log, log, unlines, (.))
import System.Console.GetOpt (getOpt, ArgOrder(Permute), OptDescr(Option), ArgDescr(ReqArg))
import System.Environment (getArgs)
import System.FilePath ((</>))
import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)
data Atoms
= Atoms
{ noDocumentationLibrary_ :: Bool
, noProfilingLibrary_ :: Bool
, noHoogle_ :: Bool
, omitLTDeps_ :: Bool
, buildDir_ :: Set FilePath
, buildEnv_ :: EnvSet
, flags_ :: Flags
, debianNameMap_ :: Map PackageName VersionSplits
, control_ :: S.SourceDebDescription
, sourcePackageName_ :: Maybe SrcPkgName
, revision_ :: Maybe String
, debVersion_ :: Maybe DebianVersion
, maintainerOld_ :: Maybe NameAddr
, cabalFlagAssignments_ :: Set (FlagName, Bool)
, sourceFormat_ :: Maybe SourceFormat
, watch_ :: Maybe Text
, intermediateFiles_ :: Set (FilePath, Text)
, rulesHead_ :: Maybe Text
, rulesFragments_ :: Set Text
, warning_ :: Set Text
, utilsPackageNameBase_ :: Maybe String
, changelog_ :: Maybe ChangeLog
, comments_ :: Maybe [[Text]]
, missingDependencies_ :: Set BinPkgName
, extraLibMap_ :: Map String Relations
, execMap_ :: Map String Relations
, epochMap_ :: Map PackageName Int
, packageInfo_ :: Map PackageName PackageInfo
, compat_ :: Maybe Int
, copyright_ :: Maybe Text
, license_ :: Maybe License
, licenseFile_ :: Maybe Text
, apacheSite_ :: Map BinPkgName (String, FilePath, Text)
, logrotateStanza_ :: Map BinPkgName (Set Text)
, postInst_ :: Map BinPkgName Text
, postRm_ :: Map BinPkgName Text
, preInst_ :: Map BinPkgName Text
, preRm_ :: Map BinPkgName Text
, sourceArchitecture_ :: Maybe PackageArchitectures
, binaryArchitectures_ :: Map BinPkgName PackageArchitectures
, sourcePriority_ :: Maybe PackagePriority
, binaryPriorities_ :: Map BinPkgName PackagePriority
, sourceSection_ :: Maybe Section
, binarySections_ :: Map BinPkgName Section
#if 0
, link_ :: Map BinPkgName (Set (FilePath, FilePath))
, install_ :: Map BinPkgName (Set (FilePath, FilePath))
, installTo_ :: Map BinPkgName (Set (FilePath, FilePath))
, installData_ :: Map BinPkgName (Set (FilePath, FilePath))
, file_ :: Map BinPkgName (Set (FilePath, Text))
, installCabalExec_ :: Map BinPkgName (Set (String, FilePath))
, installCabalExecTo_ :: Map BinPkgName (Set (String, FilePath))
, installDir_ :: Map BinPkgName (Set FilePath)
#else
, atomSet_ :: Set Atom
#endif
, installInit_ :: Map BinPkgName Text
, executable_ :: Map BinPkgName InstallFile
, serverInfo_ :: Map BinPkgName Server
, website_ :: Map BinPkgName Site
, backups_ :: Map BinPkgName String
, extraDevDeps_ :: Relations
, packageDescription_ :: Maybe PackageDescription
, compilerFlavors_ :: Set CompilerFlavor
} deriving (Eq, Show, Data, Typeable)
data Atom
= Link BinPkgName FilePath FilePath
| Install BinPkgName FilePath FilePath
| InstallTo BinPkgName FilePath FilePath
| InstallData BinPkgName FilePath FilePath
| File BinPkgName FilePath Text
| InstallCabalExec BinPkgName String FilePath
| InstallCabalExecTo BinPkgName String FilePath
| InstallDir BinPkgName FilePath
deriving (Show, Eq, Ord, Data, Typeable)
type Atoms' = Set Atom
data EnvSet = EnvSet
{ cleanOS :: FilePath
, dependOS :: FilePath
, buildOS :: FilePath
} deriving (Eq, Show, Data, Typeable)
newAtoms :: MonadIO m => m Atoms
newAtoms = liftIO $ do
(roots, _, _) <- getOpt Permute [Option "buildenvdir" [] (ReqArg id "PATH")
"Directory containing the build environment"] <$> getArgs
let envset = case roots of
(x : _) -> EnvSet {cleanOS = x </> "clean", dependOS = x </> "depend", buildOS = x </> "build"}
_ -> EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}
return $ makeAtoms envset
makeAtoms :: EnvSet -> Atoms
makeAtoms envset =
Atoms
{ noDocumentationLibrary_ = False
, noProfilingLibrary_ = False
, noHoogle_ = False
, omitLTDeps_ = False
, buildDir_ = mempty
, buildEnv_ = envset
, flags_ = defaultFlags
, debianNameMap_ = mempty
, control_ = S.newSourceDebDescription
, sourcePackageName_ = Nothing
, revision_ = Nothing
, debVersion_ = Nothing
, maintainerOld_ = Nothing
, cabalFlagAssignments_ = mempty
, sourceFormat_ = Nothing
, watch_ = Nothing
, intermediateFiles_ = mempty
, rulesHead_ = Nothing
, rulesFragments_ = mempty
, warning_ = mempty
, utilsPackageNameBase_ = Nothing
, changelog_ = Nothing
, comments_ = Nothing
, missingDependencies_ = mempty
, extraLibMap_ = mempty
, execMap_ = mempty
, epochMap_ = mempty
, packageInfo_ = mempty
, compat_ = Nothing
, copyright_ = Nothing
, license_ = Nothing
, licenseFile_ = mempty
, apacheSite_ = mempty
, logrotateStanza_ = mempty
, postInst_ = mempty
, postRm_ = mempty
, preInst_ = mempty
, preRm_ = mempty
, sourceArchitecture_ = Nothing
, binaryArchitectures_ = mempty
, sourcePriority_ = Nothing
, binaryPriorities_ = mempty
, sourceSection_ = Nothing
, binarySections_ = mempty
#if 0
, link_ = mempty
, install_ = mempty
, installTo_ = mempty
, installData_ = mempty
, file_ = mempty
, installCabalExec_ = mempty
, installCabalExecTo_ = mempty
, installDir_ = mempty
#else
, atomSet_ = mempty
#endif
, installInit_ = mempty
, executable_ = mempty
, serverInfo_ = mempty
, website_ = mempty
, backups_ = mempty
, extraDevDeps_ = mempty
, packageDescription_ = Nothing
, compilerFlavors_ = singleton GHC
}
data Flags = Flags
{
verbosity_ :: Int
, dryRun_ :: Bool
, validate_ :: Bool
, debAction_ :: DebAction
} deriving (Eq, Ord, Show, Data, Typeable)
data DebAction = Usage | Debianize | SubstVar DebType deriving (Read, Show, Eq, Ord, Data, Typeable)
data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable)
data PackageInfo = PackageInfo { cabalName :: PackageName
, devDeb :: Maybe (BinPkgName, DebianVersion)
, profDeb :: Maybe (BinPkgName, DebianVersion)
, docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable)
data Site
= Site
{ domain :: String
, serverAdmin :: String
, server :: Server
} deriving (Read, Show, Eq, Ord, Data, Typeable)
data Server
= Server
{ hostname :: String
, port :: Int
, headerMessage :: String
, retry :: String
, serverFlags :: [String]
, installFile :: InstallFile
} deriving (Read, Show, Eq, Ord, Data, Typeable)
data InstallFile
= InstallFile
{ execName :: String
, sourceDir :: Maybe FilePath
, destDir :: Maybe FilePath
, destName :: String
} deriving (Read, Show, Eq, Ord, Data, Typeable)
defaultFlags :: Flags
defaultFlags =
Flags {
verbosity_ = 1
, debAction_ = Debianize
, dryRun_ = False
, validate_ = False
}
showAtoms :: Atoms -> IO ()
showAtoms x = putStrLn ("\nTop: " ++ show x ++ "\n")
verbosity :: Lens Atoms Int
verbosity = lens verbosity_ (\ b a -> a {verbosity_ = b}) . flags
dryRun :: Lens Atoms Bool
dryRun = lens dryRun_ (\ b a -> a {dryRun_ = b}) . flags
validate :: Lens Atoms Bool
validate = lens validate_ (\ b a -> a {validate_ = b}) . flags
debAction :: Lens Atoms DebAction
debAction = lens debAction_ (\ b a -> a {debAction_ = b}) . flags
flags :: Lens Atoms Flags
flags = lens flags_ (\ b a -> a {flags_ = b})
warning :: Lens Atoms (Set Text)
warning = lens warning_ (\ a b -> b {warning_ = a})
buildDir :: Lens Atoms (Set FilePath)
buildDir = lens buildDir_ (\ b a -> a {buildDir_ = b})
buildEnv :: Lens Atoms EnvSet
buildEnv = lens buildEnv_ (\ b a -> a {buildEnv_ = b})
setBuildEnv :: MonadIO m => EnvSet -> Atoms -> m Atoms
setBuildEnv envset atoms = return $ atoms {buildEnv_ = envset}
extraLibMap :: Lens Atoms (Map String Relations)
extraLibMap = lens extraLibMap_ (\ a b -> b {extraLibMap_ = a})
execMap :: Lens Atoms (Map String Relations)
execMap = lens execMap_ (\ a b -> b {execMap_ = a})
cabalFlagAssignments :: Lens Atoms (Set (FlagName, Bool))
cabalFlagAssignments = lens cabalFlagAssignments_ (\ a b -> b {cabalFlagAssignments_ = a})
packageDescription :: Lens Atoms (Maybe PackageDescription)
packageDescription = lens packageDescription_ (\ a b -> b {packageDescription_ = a})
debianNameMap :: Lens Atoms (Map PackageName VersionSplits)
debianNameMap = lens debianNameMap_ (\ a b -> b {debianNameMap_ = a})
epochMap :: Lens Atoms (Map PackageName Int)
epochMap = lens epochMap_ (\ a b -> b {epochMap_ = a})
executable :: Lens Atoms (Map BinPkgName InstallFile)
executable = lens executable_ (\ a b -> b {executable_ = a})
serverInfo :: Lens Atoms (Map BinPkgName Server)
serverInfo = lens serverInfo_ (\ a b -> b {serverInfo_ = a})
website :: Lens Atoms (Map BinPkgName Site)
website = lens website_ (\ a b -> b {website_ = a})
backups :: Lens Atoms (Map BinPkgName String)
backups = lens backups_ (\ a b -> b {backups_ = a})
apacheSite :: Lens Atoms (Map BinPkgName (String, FilePath, Text))
apacheSite = lens apacheSite_ (\ a b -> b {apacheSite_ = a})
missingDependencies :: Lens Atoms (Set BinPkgName)
missingDependencies = lens missingDependencies_ (\ a b -> b {missingDependencies_ = a})
utilsPackageNameBase :: Lens Atoms (Maybe String)
utilsPackageNameBase = lens utilsPackageNameBase_ (\ a b -> b {utilsPackageNameBase_ = a})
sourcePackageName :: Lens Atoms (Maybe SrcPkgName)
sourcePackageName = lens sourcePackageName_ (\ a b -> b {sourcePackageName_ = a})
revision :: Lens Atoms (Maybe String)
revision = lens revision_ (\ a b -> b {revision_ = a})
debVersion :: Lens Atoms (Maybe DebianVersion)
debVersion = lens debVersion_ (\ b a -> a {debVersion_ = b})
packageInfo :: Lens Atoms (Map PackageName PackageInfo)
packageInfo = lens packageInfo_ (\ a b -> b {packageInfo_ = a})
omitLTDeps :: Lens Atoms Bool
omitLTDeps = lens omitLTDeps_ (\ b a -> a {omitLTDeps_ = b})
noProfilingLibrary :: Lens Atoms Bool
noProfilingLibrary = lens noProfilingLibrary_ (\ b a -> a {noProfilingLibrary_ = b})
noHoogle :: Lens Atoms Bool
noHoogle = lens noHoogle_ (\ b a -> a {noHoogle_ = b})
noDocumentationLibrary :: Lens Atoms Bool
noDocumentationLibrary = lens noDocumentationLibrary_ (\ b a -> a {noDocumentationLibrary_ = b})
copyright :: Lens Atoms (Maybe Text)
copyright = lens copyright_ (\ a b -> b {copyright_ = a})
license :: Lens Atoms (Maybe License)
license = lens license_ (\ a b -> b {license_ = a})
licenseFile :: Lens Atoms (Maybe Text)
licenseFile = lens licenseFile_ (\ a b -> b {licenseFile_ = a})
sourceArchitectures :: Lens Atoms (Maybe PackageArchitectures)
sourceArchitectures = lens sourceArchitecture_ (\ a b -> b {sourceArchitecture_ = a})
extraDevDeps :: Lens Atoms Relations
extraDevDeps = lens extraDevDeps_ (\ a b -> b {extraDevDeps_ = a})
rulesHead :: Lens Atoms (Maybe Text)
rulesHead = lens rulesHead_ (\ a b -> b {rulesHead_ = a})
rulesFragments :: Lens Atoms (Set Text)
rulesFragments = lens rulesFragments_ (\ a b -> b {rulesFragments_ = a})
postInst :: Lens Atoms (Map BinPkgName Text)
postInst = lens postInst_ (\ a b -> b {postInst_ = a})
postRm :: Lens Atoms (Map BinPkgName Text)
postRm = lens postRm_ (\ a b -> b {postRm_ = a})
preInst :: Lens Atoms (Map BinPkgName Text)
preInst = lens preInst_ (\ a b -> b {preInst_ = a})
preRm :: Lens Atoms (Map BinPkgName Text)
preRm = lens preRm_ (\ a b -> b {preRm_ = a})
compat :: Lens Atoms (Maybe Int)
compat = lens compat_ (\ a b -> b {compat_ = a})
sourceFormat :: Lens Atoms (Maybe SourceFormat)
sourceFormat = lens sourceFormat_ (\ a b -> b {sourceFormat_ = a})
watch :: Lens Atoms (Maybe Text)
watch = lens watch_ (\ a b -> b {watch_ = a})
changelog :: Lens Atoms (Maybe ChangeLog)
changelog = lens changelog_ (\ a b -> b {changelog_ = a})
comments :: Lens Atoms (Maybe [[Text]])
comments = lens comments_ (\ a b -> b {comments_ = a})
control :: Lens Atoms S.SourceDebDescription
control = lens control_ (\ a b -> b {control_ = a})
logrotateStanza :: Lens Atoms (Map BinPkgName (Set Text))
logrotateStanza = lens logrotateStanza_ (\ a b -> b {logrotateStanza_ = a})
#if 0
link :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))
link = lens link_ (\ a b -> b {link_ = a})
install :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))
install = lens install_ (\ a b -> b {install_ = a})
installTo :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))
installTo = lens installTo_ (\ a b -> b {installTo_ = a})
installData :: Lens Atoms (Map BinPkgName (Set (FilePath, FilePath)))
installData = lens installData_ (\ a b -> b {installData_ = a})
file :: Lens Atoms (Map BinPkgName (Set (FilePath, Text)))
file = lens file_ (\ a b -> b {file_ = a})
installCabalExec :: Lens Atoms (Map BinPkgName (Set (String, FilePath)))
installCabalExec = lens installCabalExec_ (\ a b -> b {installCabalExec_ = a})
installCabalExecTo :: Lens Atoms (Map BinPkgName (Set (String, FilePath)))
installCabalExecTo = lens installCabalExecTo_ (\ a b -> b {installCabalExecTo_ = a})
installDir :: Lens Atoms (Map BinPkgName (Set FilePath))
installDir = lens installDir_ (\ a b -> b {installDir_ = a})
#else
atomSet :: Lens Atoms (Set Atom)
atomSet = lens atomSet_ (\ a b -> b {atomSet_ = a})
link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()
link b from dest = atomSet %= (Set.insert $ Link b from dest) >> return ()
install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()
install b from dest = atomSet %= (Set.insert $ Install b from dest) >> return ()
installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()
installTo b from dest = atomSet %= (Set.insert $ InstallTo b from dest) >> return ()
installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT Atoms m ()
installData b from dest = atomSet %= (Set.insert $ InstallData b from dest) >> return ()
file :: Monad m => BinPkgName -> FilePath -> Text -> StateT Atoms m ()
file b dest content = atomSet %= (Set.insert $ File b dest content) >> return ()
installCabalExec :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()
installCabalExec b name dest = atomSet %= (Set.insert $ InstallCabalExec b name dest) >> return ()
installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT Atoms m ()
installCabalExecTo b name dest = atomSet %= (Set.insert $ InstallCabalExecTo b name dest) >> return ()
installDir :: Monad m => BinPkgName -> FilePath -> StateT Atoms m ()
installDir b dir = atomSet %= (Set.insert $ InstallDir b dir) >> return ()
#endif
installInit :: Lens Atoms (Map BinPkgName Text)
installInit = lens installInit_ (\ a b -> b {installInit_ = a})
intermediateFiles :: Lens Atoms (Set (FilePath, Text))
intermediateFiles = lens intermediateFiles_ (\ a b -> b {intermediateFiles_ = a})
compilerFlavors :: Lens Atoms (Set CompilerFlavor)
compilerFlavors = lens compilerFlavors_ (\ a b -> b {compilerFlavors_ = a})