diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Thomas Tuegel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Thomas Tuegel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/autonix-deps.cabal b/autonix-deps.cabal new file mode 100644 --- /dev/null +++ b/autonix-deps.cabal @@ -0,0 +1,49 @@ +name: autonix-deps +version: 0.1.0.0 +synopsis: Library for Nix expression dependency generation +license: BSD3 +license-file: LICENSE +author: Thomas Tuegel +maintainer: ttuegel@gmail.com +copyright: 2014 Thomas Tuegel +category: System +build-type: Simple +cabal-version: >=1.10 +bug-reports: https://github.com/ttuegel/autonix-deps/issues +description: + @autonix-deps@ is a library for building automatic dependency detectors for + software collections to be built using the Nix package manager. + +source-repository head + type: git + location: https://github.com/ttuegel/autonix-deps.git + +library + exposed-modules: + Autonix.Analyze + Autonix.Args + Autonix.CMake + Autonix.Deps + Autonix.Generate + Autonix.Manifest + Autonix.PkgDeps + Autonix.Regex + build-depends: + base >=4.7 && <5 + , bytestring >=0.10 + , conduit >=1.2 + , containers >=0.5 + , errors >=1.4 + , filepath >=1.3 + , lens >=4.0 + , libarchive-conduit ==0.1.* + , mtl >=2.1 + , optparse-applicative >=0.11 + , process >=1.2 + , regex-tdfa >=1.2 + , resourcet >=1.1 + , transformers >=0.3 + , xml >=1.3 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Autonix/Analyze.hs b/src/Autonix/Analyze.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Analyze.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Autonix.Analyze + ( Analyzer + , analyzeFiles + , analyzePackages + ) where + +import Codec.Archive +import Control.Lens hiding (act) +import Control.Monad.State +import Control.Monad.Trans.Resource +import qualified Data.ByteString.Char8 as B +import Data.Conduit +import qualified Data.Map as M +import Data.Monoid +import qualified Data.Set as S +import Prelude hiding (mapM) + +import Autonix.Deps +import Autonix.Manifest + +type Analyzer m = ByteString -> Sink (FilePath, ByteString) m () + +analyzePackages :: (MonadIO m, MonadState Deps m) + => (ByteString -> FilePath -> m a) + -> FilePath -> Maybe FilePath -> m () +analyzePackages perPackage manifestPath renamesPath = do + manifest <- readManifest manifestPath + renames <- readRenames renamesPath + names %= flip M.union renames + forM_ manifest $ \(pkg, _) -> at pkg .= Just mempty + let (pkgs, _) = unzip manifest + mapM_ (uncurry perPackage) manifest + deps %= M.filterWithKey (\k _ -> S.member k $ S.fromList pkgs) + +sequenceSinks_ :: (Traversable f, Monad m) => f (Sink i m ()) -> Sink i m () +sequenceSinks_ = void . sequenceSinks + +analyzeFiles :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) + => [Analyzer (ResourceT m)] -> ByteString -> FilePath -> m () +analyzeFiles analyzers pkg src + | null src = error $ B.unpack $ "No store path specified for " <> pkg + | otherwise = do + liftIO $ B.putStrLn $ "package " <> pkg + runResourceT + $ sourceArchive src $$ sequenceSinks_ (map ($ pkg) analyzers) diff --git a/src/Autonix/Args.hs b/src/Autonix/Args.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Args.hs @@ -0,0 +1,16 @@ +module Autonix.Args where + +import Control.Applicative +import Control.Monad (join) +import Control.Monad.IO.Class +import Options.Applicative + +withArgs :: MonadIO m => (FilePath -> Maybe FilePath -> m a) -> m a +withArgs child = + join $ liftIO $ execParser $ info (helper <*> parser) fullDesc + where + parser = child + <$> strArgument (metavar "MANIFEST") + <*> option + (Just <$> str) + (long "renames" <> metavar "FILENAME" <> value Nothing) diff --git a/src/Autonix/CMake.hs b/src/Autonix/CMake.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/CMake.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Autonix.CMake + ( analyzeCMakePackages + , analyzeCMakePrograms + , cmakeAnalyzers + , detectCMake + ) where + +import Control.Lens +import Control.Monad.IO.Class +import Control.Monad.State +import Data.Conduit +import qualified Data.Set as S +import System.FilePath (takeFileName) + +import Autonix.Analyze +import Autonix.Deps +import Autonix.Regex + +detectCMake :: MonadState Deps m => Analyzer m +detectCMake pkg = awaitForever $ \(path, _) -> do + when (takeFileName path == "CMakeLists.txt") + $ ix pkg . nativeBuildInputs %= S.insert "cmake" + +analyzeCMakePackages :: (MonadIO m, MonadState Deps m) => Analyzer m +analyzeCMakePackages pkg = awaitForever $ \(path, contents) -> do + when (takeFileName path == "CMakeLists.txt") $ do + let new = concatMap (take 1 . drop 1) $ match regex contents + regex = makeRegex + "find_package[[:space:]]*\\([[:space:]]*([^[:space:],$\\)]+)" + ix pkg . buildInputs %= S.union (S.fromList new) + +analyzeCMakePrograms :: (MonadIO m, MonadState Deps m) => Analyzer m +analyzeCMakePrograms pkg = awaitForever $ \(path, contents) -> do + when (takeFileName path == "CMakeLists.txt") $ do + let new = concatMap (take 1 . drop 1) $ match regex contents + regex = makeRegex + "find_program[[:space:]]*\\([[:space:]]*([^[:space:],$\\)]+)" + ix pkg . nativeBuildInputs %= S.union (S.fromList new) + +cmakeAnalyzers :: (MonadIO m, MonadState Deps m) => [Analyzer m] +cmakeAnalyzers = [detectCMake, analyzeCMakePackages, analyzeCMakePrograms] diff --git a/src/Autonix/Deps.hs b/src/Autonix/Deps.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Deps.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Autonix.Deps + ( Deps, names, deps, rename + , module Autonix.PkgDeps + ) where + +import Control.Lens +import Control.Monad.State +import qualified Data.Map as M +import Data.Monoid +import qualified Data.Set as S +import Prelude hiding (foldr) + +import Autonix.PkgDeps + +data Deps = + Deps { _names :: Map ByteString ByteString + , _deps :: Map ByteString PkgDeps + } + deriving (Read, Show) +makeLenses ''Deps + +instance Monoid Deps where + mempty = Deps { _names = M.empty, _deps = M.empty } + + mappend a b = flip execState a $ do + let b' = execState (iforMOf_ (names.>itraversed) a rename) b + iforMOf_ (names.>itraversed) b' rename + names %= M.union (b'^.names) + deps %= M.unionWith mappend (b'^.deps) + +lookupNewName :: Deps -> ByteString -> ByteString +lookupNewName r idx = M.findWithDefault idx idx (r^.names) + +renamePkgDeps :: ByteString -> ByteString -> PkgDeps -> PkgDeps +renamePkgDeps old new = execState $ do + buildInputs %= S.map go + nativeBuildInputs %= S.map go + propagatedBuildInputs %= S.map go + propagatedNativeBuildInputs %= S.map go + propagatedUserEnvPkgs %= S.map go + where + go pkg | pkg == old = new + | otherwise = pkg + +rename :: (MonadState Deps m) => ByteString -> ByteString -> m () +rename old new = do + names %= M.insert old new + names %= M.map (\tgt -> if tgt == old then new else tgt) + deps %= M.map (renamePkgDeps old new) + ds <- get + deps %= M.mapKeysWith mappend (lookupNewName ds) + +applyRenames :: Deps -> PkgDeps -> PkgDeps +applyRenames r = execState $ do + buildInputs %= S.map (lookupNewName r) + propagatedBuildInputs %= S.map (lookupNewName r) + nativeBuildInputs %= S.map (lookupNewName r) + propagatedNativeBuildInputs %= S.map (lookupNewName r) + propagatedUserEnvPkgs %= S.map (lookupNewName r) + +type instance Index Deps = ByteString +type instance IxValue Deps = PkgDeps + +instance Ixed Deps where + ix idx f r = + (deps . ix (lookupNewName r idx)) (fmap (applyRenames r) . f) r + +instance At Deps where + at idx f r = + (deps . at (lookupNewName r idx)) (fmap (fmap $ applyRenames r) . f) r diff --git a/src/Autonix/Generate.hs b/src/Autonix/Generate.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Generate.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +module Autonix.Generate (generateDeps, writeDeps, writeRenames) where + +import Control.Lens +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Control.Monad.State +import qualified Data.ByteString.Char8 as B +import qualified Data.Map as M +import Data.Monoid +import qualified Data.Set as S + +import Autonix.Analyze +import Autonix.Args +import Autonix.Deps + +generateDeps :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) + => [Analyzer (ResourceT (StateT Deps m))] + -> StateT Deps m () +generateDeps analyzers = do + withArgs $ analyzePackages (analyzeFiles analyzers) + get >>= writeDeps + get >>= writeRenames + +writeDeps :: MonadIO m => Deps -> m () +writeDeps = liftIO . B.writeFile "dependencies.nix" . depsToNix + +writeRenames :: MonadIO m => Deps -> m () +writeRenames ds = do + let renames = B.unlines $ do + (old, new) <- M.toList (ds^.names) + return $ old <> " " <> new + liftIO $ B.writeFile "renames.txt" renames + +packageDeps :: (ByteString, PkgDeps) -> ByteString +packageDeps (name, ds) = + B.unlines + [ " " <> name <> " = {" + , " buildInputs = [ " + <> listInputs buildInputs + <> " ];" + , " nativeBuildInputs = [ " + <> listInputs nativeBuildInputs + <> " ];" + , " propagatedBuildInputs = [ " + <> listInputs propagatedBuildInputs + <> " ];" + , " propagatedNativeBuildInputs = [ " + <> listInputs propagatedNativeBuildInputs + <> " ];" + , " propagatedUserEnvPkgs = [ " + <> listInputs propagatedUserEnvPkgs + <> " ];" + , " };" + ] + where + listInputs l = B.unwords $ map quoted $ S.toList $ ds^.l + quoted x = "\"" <> x <> "\"" + +depsToNix :: Deps -> ByteString +depsToNix (view deps -> ds) = + B.unlines + ( [ "# DO NOT EDIT! This file is generated automatically." + , "{ }:" + , "{" + ] + ++ map packageDeps (M.toList ds) ++ + [ "}" ] + ) diff --git a/src/Autonix/Manifest.hs b/src/Autonix/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Manifest.hs @@ -0,0 +1,47 @@ +module Autonix.Manifest (readManifest, readRenames) where + +import Control.Applicative +import Control.Error +import Control.Monad (liftM) +import Control.Monad.IO.Class +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.Map (Map) +import qualified Data.Map as M +import Text.XML.Light + +type Manifest = [(ByteString, FilePath)] + +readManifest :: MonadIO m => FilePath -> m Manifest +readManifest path = + liftM (fromMaybe $ error "malformed manifest.xml") + $ liftIO $ runMaybeT $ do + xml <- MaybeT $ parseXMLDoc <$> B.readFile path + attrs <- + MaybeT $ return + $ if qName (elName xml) == "expr" + then case headMay (elChildren xml) of + Just el | qName (elName el) == "attrs" -> Just el + _ -> Nothing + else Nothing + return $ attrsToManifest attrs + +attrsToManifest :: Element -> Manifest +attrsToManifest = mapMaybe go . filterChildrenName isAttr where + isAttr name = qName name == "attr" + go el = do + name <- findAttr (blank_name { qName = "name" }) el + child <- headMay $ elChildren el + value <- findAttr (blank_name { qName = "value"}) child + return (B.pack name, value) + +readRenames :: MonadIO m => Maybe FilePath -> m (Map ByteString ByteString) +readRenames renamesPath = do + case renamesPath of + Nothing -> return M.empty + Just path -> + liftM (M.fromList . map (toPair . B.words) . B.lines) + $ liftIO $ B.readFile path + where + toPair [old, new] = (old, new) + toPair _ = error "readRenames: invalid line" diff --git a/src/Autonix/PkgDeps.hs b/src/Autonix/PkgDeps.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/PkgDeps.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Autonix.PkgDeps + ( PkgDeps + , buildInputs, nativeBuildInputs + , propagatedBuildInputs, propagatedNativeBuildInputs + , propagatedUserEnvPkgs + , module Data.ByteString + , module Data.Map + , module Data.Set + ) where + +import Control.Lens +import Control.Monad.State (execState) +import Data.ByteString (ByteString) +import Data.Map (Map) +import Data.Monoid +import Data.Set (Set) +import qualified Data.Set as S + +data PkgDeps = + PkgDeps + { _buildInputs :: Set ByteString + , _nativeBuildInputs :: Set ByteString + , _propagatedBuildInputs :: Set ByteString + , _propagatedNativeBuildInputs :: Set ByteString + , _propagatedUserEnvPkgs :: Set ByteString + } + deriving (Eq, Ord, Read, Show) +makeLenses ''PkgDeps + +instance Monoid PkgDeps where + mempty = + PkgDeps + { _buildInputs = S.empty + , _nativeBuildInputs = S.empty + , _propagatedBuildInputs = S.empty + , _propagatedNativeBuildInputs = S.empty + , _propagatedUserEnvPkgs = S.empty + } + + mappend a = execState $ do + buildInputs %= mappend (a^.buildInputs) + nativeBuildInputs %= mappend (a^.nativeBuildInputs) + propagatedBuildInputs %= mappend (a^.propagatedBuildInputs) + propagatedNativeBuildInputs %= mappend (a^.propagatedNativeBuildInputs) + propagatedUserEnvPkgs %= mappend (a^.propagatedUserEnvPkgs) diff --git a/src/Autonix/Regex.hs b/src/Autonix/Regex.hs new file mode 100644 --- /dev/null +++ b/src/Autonix/Regex.hs @@ -0,0 +1,11 @@ +module Autonix.Regex (match, makeRegex) where + +import Data.ByteString (ByteString) +import Text.Regex.TDFA (Regex) +import qualified Text.Regex.TDFA as R + +match :: Regex -> ByteString -> [[ByteString]] +match = R.match + +makeRegex :: ByteString -> Regex +makeRegex = R.makeRegex