packages feed

autonix-deps 0.2.0.0 → 0.3.0.0

raw patch · 12 files changed

+262/−267 lines, 12 filesdep +aesondep +aeson-prettydep +semigroups

Dependencies added: aeson, aeson-pretty, semigroups, text

Files

autonix-deps.cabal view
@@ -1,5 +1,5 @@ name:                autonix-deps-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Library for Nix expression dependency generation license:             BSD3 license-file:        LICENSE@@ -20,16 +20,18 @@  library   exposed-modules:+    Autonix     Autonix.Analyze-    Autonix.Args     Autonix.CMake-    Autonix.Deps-    Autonix.Generate     Autonix.Manifest-    Autonix.PkgDeps+    Autonix.Package     Autonix.Regex+    Autonix.Renames+    Autonix.Src   build-depends:       base >=4.7 && <5+    , aeson >= 0.9+    , aeson-pretty >= 0.7     , bytestring >=0.10     , conduit >=1.2     , containers >=0.5@@ -42,6 +44,8 @@     , process >=1.2     , regex-tdfa >=1.2     , resourcet >=1.1+    , semigroups >= 0.16+    , text >= 1.2     , transformers >=0.3     , xml >=1.3   hs-source-dirs:      src
+ src/Autonix.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Autonix (autonix) where++import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Control.Monad.State+import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.ByteString.Lazy as BL+import Data.Map.Strict (Map)+import Data.Text (Text)+import Options.Applicative++import Autonix.Analyze+import Autonix.Package (Package)+import Autonix.Renames++autonix :: (MonadBaseControl IO m, MonadIO m, MonadThrow m)+        => [Analyzer (StateT (Map Text Package, Renames) m)]+        -> m ()+autonix analyzers = do+    (pkgs, renames) <- withArgs (analyzePackages (analyzeFiles analyzers))+    writePackages pkgs+    writeRenames renames++withArgs :: MonadIO m => (FilePath -> m a) -> m a+withArgs child =+    join $ liftIO $ execParser $ info (helper <*> parser) fullDesc+  where+    parser = child <$> strArgument (metavar "MANIFEST")++writePackages :: MonadIO m => Map Text Package -> m ()+writePackages = liftIO . BL.writeFile "packages.json" . encodePretty
src/Autonix/Analyze.hs view
@@ -8,39 +8,44 @@        ) where  import Codec.Archive-import Control.Lens hiding (act)+import Control.Lens import Control.Monad.State import Control.Monad.Trans.Resource-import qualified Data.ByteString.Char8 as B+import Data.ByteString (ByteString) import Data.Conduit-import qualified Data.Map as M-import Data.Monoid-import qualified Data.Set as S+import Data.Map (Map)+import Data.Semigroup+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T import Prelude hiding (mapM) -import Autonix.Deps-import Autonix.Manifest+import Autonix.Manifest (Manifest, readManifests)+import qualified Autonix.Manifest as Manifest+import Autonix.Package (Package, package)+import Autonix.Renames -type Analyzer m = ByteString -> Sink (FilePath, ByteString) m ()+type Analyzer m = Text -> Manifest -> Sink (FilePath, ByteString) (ResourceT m) () -analyzePackages :: (MonadIO m, MonadState Deps m)-                => (ByteString -> FilePath -> m a)-                -> FilePath -> m ()-analyzePackages perPackage manifestPath = do-    manifest <- readManifest manifestPath-    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)+analyzePackages :: MonadIO m => (Text -> Manifest -> StateT (Map Text Package, Renames) m ())+                -> FilePath -> m (Map Text Package, Renames)+analyzePackages perPackage manifestPath = flip execStateT (mempty, mempty) $ do+    manifests <- readManifests manifestPath+    imapM_ perPackage manifests  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+analyzeFiles :: (MonadBaseControl IO m, MonadIO m, MonadState (Map Text Package, Renames) m, MonadThrow m)+             => [Analyzer m] -> Text -> Manifest -> m ()+analyzeFiles analyzers name m+    | null (m^.Manifest.store) = error (T.unpack noStore)     | otherwise = do-        liftIO $ B.putStrLn $ "package " <> pkg-        runResourceT-            $ sourceArchive src $$ sequenceSinks_ (map ($ pkg) analyzers)+        liftIO $ T.putStrLn $ "package " <> name+        let conduits = sourceArchive (m^.Manifest.store) $$ sequenceSinks_ sinks+            sinks = analyzers >>= \analyze -> return (analyze name m)+            pkg = package (m^.Manifest.name) (m^.Manifest.src)+        _1 . at name %= Just . maybe pkg (pkg <>)+        runResourceT conduits+  where+    noStore = "No store path specified for " <> (m^.Manifest.name)
− src/Autonix/Args.hs 
@@ -1,12 +0,0 @@-module Autonix.Args where--import Control.Applicative-import Control.Monad (join)-import Control.Monad.IO.Class-import Options.Applicative--withArgs :: MonadIO m => (FilePath -> m a) -> m a-withArgs child =-    join $ liftIO $ execParser $ info (helper <*> parser) fullDesc-  where-    parser = child <$> strArgument (metavar "MANIFEST")
src/Autonix/CMake.hs view
@@ -12,33 +12,45 @@ import Control.Monad.IO.Class import Control.Monad.State import Data.Conduit+import Data.Map (Map) import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import System.FilePath (takeFileName)  import Autonix.Analyze-import Autonix.Deps+import Autonix.Package (Package)+import qualified Autonix.Package as Package import Autonix.Regex+import Autonix.Renames -detectCMake :: MonadState Deps m => Analyzer m-detectCMake pkg = awaitForever $ \(path, _) -> do+detectCMake :: (Monad m, MonadState (Map Text Package, Renames) m) => Analyzer m+detectCMake pkg _ = awaitForever $ \(path, _) ->     when (takeFileName path == "CMakeLists.txt")-        $ ix pkg . nativeBuildInputs %= S.insert "cmake"+        $ _1 . ix pkg . Package.nativeBuildInputs %= S.insert "cmake" -analyzeCMakePackages :: (MonadIO m, MonadState Deps m) => Analyzer m-analyzeCMakePackages pkg = awaitForever $ \(path, contents) -> do+analyzeCMakePackages :: (MonadIO m, MonadState (Map Text Package, Renames) 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+        let new = S.fromList+                  $ map (T.toLower . T.decodeUtf8)+                  $ concatMap (take 1 . drop 1)+                  $ match regex contents             regex = makeRegex                     "find_package[[:space:]]*\\([[:space:]]*([^[:space:],$\\)]+)"-        ix pkg . buildInputs %= S.union (S.fromList new)+        _1 . ix pkg . Package.buildInputs <>= new -analyzeCMakePrograms :: (MonadIO m, MonadState Deps m) => Analyzer m-analyzeCMakePrograms pkg = awaitForever $ \(path, contents) -> do+analyzeCMakePrograms :: (MonadIO m, MonadState (Map Text Package, Renames) 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+        let new = S.fromList+                  $ map (T.toLower . T.decodeUtf8)+                  $ concatMap (take 1 . drop 1)+                  $ match regex contents             regex = makeRegex                     "find_program[[:space:]]*\\([[:space:]]*([^[:space:],$\\)]+)"-        ix pkg . nativeBuildInputs %= S.union (S.fromList new)+        _1 . ix pkg . Package.nativeBuildInputs <>= new -cmakeAnalyzers :: (MonadIO m, MonadState Deps m) => [Analyzer m]+cmakeAnalyzers :: (MonadIO m, MonadState (Map Text Package, Renames) m) => [Analyzer m] cmakeAnalyzers = [detectCMake, analyzeCMakePackages, analyzeCMakePrograms]
− src/Autonix/Deps.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-}--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 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)--rename :: (MonadState Deps m) => ByteString -> ByteString -> m ()-rename old new = names %= M.insert old new--type instance Index Deps = ByteString-type instance IxValue Deps = PkgDeps--instance Ixed Deps where-    ix idx = deps . ix idx--instance At Deps where-    at idx = deps . at idx
− src/Autonix/Generate.hs 
@@ -1,80 +0,0 @@-{-# 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 = liftIO $ do-  let renames = do-        (old, new) <- M.toList (ds^.names)-        return ("\"" <> old <> "\" = \"" <> new <> "\";")-  B.writeFile-    "renames.nix"-    (B.unlines-      ([ "# DO NOT EDIT! This file is generated automatically."-       , "{ }:"-       , "{"-       ]-       ++ 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) ++-      [ "}" ]-    )
src/Autonix/Manifest.hs view
@@ -1,47 +1,67 @@-module Autonix.Manifest (readManifest, readRenames) where+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} -import Control.Applicative-import Control.Error-import Control.Monad (liftM)+module Autonix.Manifest+       ( Manifest, name, store, src+       , readManifests+       ) where++import Control.Lens import Control.Monad.IO.Class-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B+import Data.Aeson+import Data.Aeson.Types+import qualified Data.ByteString.Lazy as BL+import qualified Data.Char as Char import Data.Map (Map) import qualified Data.Map as M-import Text.XML.Light+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics -type Manifest = [(ByteString, FilePath)]+import Autonix.Src (Src) -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+data Manifest =+  Manifest { _name :: Text+           , _store :: FilePath+           , _src :: Src+           }+  deriving Generic+makeLenses ''Manifest -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)+manifestOptions :: Options+manifestOptions = defaultOptions { fieldLabelModifier = tail } -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+instance FromJSON Manifest where+  parseJSON = genericParseJSON manifestOptions++instance ToJSON Manifest where+  toJSON = genericToJSON manifestOptions++readManifests :: MonadIO m => FilePath -> m (Map Text Manifest)+readManifests path = do+  emanifests <- eitherDecode' <$> liftIO (BL.readFile path)+  case emanifests :: Either String [Manifest] of+    Left err -> error ("readManifests: could not read manifest.json\n" ++ err)+    Right manifests -> return (foldr assemble M.empty manifests)   where-    toPair [old, new] = (old, new)-    toPair _ = error "readRenames: invalid line"+    assemble :: Manifest -> Map Text Manifest -> Map Text Manifest+    assemble manifest =+      M.insertWith keepLatestVersion (onlyName $ view name manifest) manifest++    onlyName :: Text -> Text+    onlyName nameAndVersion =+      T.intercalate "-"+      $ takeWhile headNotDigit+      $ T.splitOn "-" nameAndVersion++    headNotDigit :: Text -> Bool+    headNotDigit txt | T.null txt = True+                     | otherwise = not $ Char.isDigit (T.head txt)++    keepLatestVersion :: Manifest -> Manifest -> Manifest+    keepLatestVersion l r =+      case compare (l^.name) (r^.name) of+        LT -> r+        EQ -> l+        GT -> l
+ src/Autonix/Package.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Autonix.Package+       ( Package, package+       , name, src+       , buildInputs+       , nativeBuildInputs+       , propagatedBuildInputs+       , propagatedNativeBuildInputs+       , propagatedUserEnvPkgs+       ) where++import Control.Lens+import Data.Aeson+import Data.Aeson.Types+import Data.Semigroup+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import GHC.Generics++import Autonix.Src (Src)++data Package =+  Package { _name :: Text+          , _src :: Src+          , _buildInputs :: Set Text+          , _nativeBuildInputs :: Set Text+          , _propagatedBuildInputs :: Set Text+          , _propagatedNativeBuildInputs :: Set Text+          , _propagatedUserEnvPkgs :: Set Text+          }+  deriving Generic+makeLenses ''Package++packageOptions :: Options+packageOptions = defaultOptions { fieldLabelModifier = tail }++instance FromJSON Package where+  parseJSON = genericParseJSON packageOptions++instance ToJSON Package where+  toJSON = genericToJSON packageOptions++instance Semigroup Package where+  (<>) a =   (buildInputs <>~ a^.buildInputs)+           . (nativeBuildInputs <>~ a^.nativeBuildInputs)+           . (propagatedBuildInputs <>~ a^.propagatedBuildInputs)+           . (propagatedNativeBuildInputs <>~ a^.propagatedNativeBuildInputs)+           . (propagatedUserEnvPkgs <>~ a^.propagatedUserEnvPkgs)++package :: Text -> Src -> Package+package n s =+  Package { _name = n+          , _src = s+          , _buildInputs = S.empty+          , _nativeBuildInputs = S.empty+          , _propagatedBuildInputs = S.empty+          , _propagatedNativeBuildInputs = S.empty+          , _propagatedUserEnvPkgs = S.empty+          }
− src/Autonix/PkgDeps.hs 
@@ -1,47 +0,0 @@-{-# 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)
+ src/Autonix/Renames.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleContexts #-}++module Autonix.Renames where++import Control.Monad.IO.Class+import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.ByteString.Lazy as BL+import Data.Map.Strict (Map)+import Data.Text (Text)++type Renames = Map Text Text++writeRenames :: MonadIO m => Renames -> m ()+writeRenames = liftIO . BL.writeFile "renames.json" . encodePretty
+ src/Autonix/Src.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Autonix.Src (Src, mkSrc, url, sha256, name) where++import Control.Lens+import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import GHC.Generics++data Src =+  Src { _url :: FilePath+      , _sha256 :: Text+      , _name :: Text+      }+  deriving Generic+makeLenses ''Src++srcOptions :: Options+srcOptions = defaultOptions { fieldLabelModifier = tail }++instance FromJSON Src where+  parseJSON = genericParseJSON srcOptions++instance ToJSON Src where+  toJSON = genericToJSON srcOptions++mkSrc :: FilePath -> Text -> Text -> Src+mkSrc = Src