stackage-to-hackage 1.0.1 → 1.0.2
raw patch · 2 files changed
+52/−34 lines, 2 files
Files
- src/Main.hs +51/−33
- stackage-to-hackage.cabal +1/−1
src/Main.hs view
@@ -3,48 +3,61 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} +import Control.Monad.Extra (ifM) import qualified Data.ByteString as BS import Data.List (sort) import Data.List.Extra (nubOn)-import Data.Map.Strict (lookup, toList)+import Data.List.NonEmpty (NonEmpty, nonEmpty)+import qualified Data.List.NonEmpty as NEL+import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe) import Data.Semigroup.Foldable (fold1)-import Data.Text (Text, concat, intercalate,- pack)+import Data.Text (Text)+import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Distribution.Pretty (prettyShow) import Distribution.Types.PackageId (PackageIdentifier (..))-import Distribution.Types.PackageName (unPackageName)+import Distribution.Types.PackageName (PackageName, mkPackageName,+ unPackageName) import OpenSSL (withOpenSSL) import qualified Options.Applicative as Opts-import Prelude hiding (concat, head, lookup,- reverse) import Stackage-import System.FilePath (takeDirectory, (</>))+import System.Directory (doesDirectoryExist,+ listDirectory)+import System.FilePath (addTrailingPathSeparator,+ takeBaseName, takeDirectory,+ takeExtension, (</>)) -{- MANUAL TEST:- LC_ALL=C cabal v2-run stackage-to-hackage -- tests/snapshot/stack.yaml- LC_ALL=C cabal v2-run stackage-to-hackage -- tests/stackage/stack.yaml- git diff tests--} main :: IO () main = withOpenSSL $ do Options{input} <- Opts.execParser $ Opts.info (Opts.helper <*> optionsParser) Opts.fullDesc text <- BS.readFile input stack <- readStack text- let dir = (takeDirectory input)+ let+ dir = (takeDirectory input) resolvers <- unroll dir stack let resolver = fold1 resolvers- freeze = genFreeze resolver project = genProject stack resolver+ dirs = NEL.toList $ (dir </>) <$> localDirs project+ cabals <- concat <$> traverse (globExt ".cabal") dirs+ let+ -- assumes that .cabal files are named correctly, otherwise we need+ -- PackageDescription-Parsec.html#v:readGenericPackageDescription+ ignore = (mkPackageName . takeBaseName) <$> cabals+ freeze = genFreeze resolver ignore BS.writeFile (dir </> "cabal.project") (encodeUtf8 $ printProject project) BS.writeFile (dir </> "cabal.project.freeze") (encodeUtf8 $ printFreeze freeze) +globExt :: String -> FilePath -> IO [FilePath]+globExt ext path = do+ files <- ifM (doesDirectoryExist path) (listDirectory path) (pure [])+ pure $ filter ((ext ==) . takeExtension) files+ printProject :: Project -> Text printProject (Project (Ghc ghc) pkgs srcs) =- concat [ "-- Generated by stackage-to-hackage from stack.yaml\n\n"+ T.concat [ "-- Generated by stackage-to-hackage from stack.yaml\n\n" , "with-compiler: ", ghc, "\n\n" , "packages:\n ", packages, "\n\n" , sources, "\n"@@ -52,23 +65,27 @@ , "allow-newer: *\n" ] where- packages = intercalate "\n , " ((<> "/"). pack <$> pkgs)- sources = intercalate "\n" (source =<< srcs)+ packages = T.intercalate "\n , " (T.pack . addTrailingPathSeparator <$>+ NEL.toList pkgs)+ sources = T.intercalate "\n" (source =<< srcs) source Git{repo, commit, subdirs} =- let base = concat [ "source-repository-package\n "+ let base = T.concat [ "source-repository-package\n " , "type: git\n " , "location: ", repo, "\n " , "tag: ", commit, "\n"] in if null subdirs then [base]- else (\d -> concat [base, " subdir: ", d, "\n"]) <$> subdirs+ else (\d -> T.concat [base, " subdir: ", d, "\n"]) <$> subdirs -data Project = Project Ghc [FilePath] [Git] deriving (Show)+data Project = Project Ghc (NonEmpty FilePath) [Git] deriving (Show) +localDirs :: Project -> NonEmpty FilePath+localDirs (Project _ nefp _ ) = nefp+ genProject :: Stack -> Resolver -> Project genProject Stack{packages} Resolver{compiler, deps} = Project (fromMaybe (Ghc "ghc") compiler)- (mapMaybe pickLocal packages)+ (fromMaybe (pure ".") (nonEmpty $ mapMaybe pickLocal packages)) (nubOn repo $ mapMaybe pickGit deps) where pickLocal (Local p) = Just p@@ -78,30 +95,31 @@ printFreeze :: Freeze -> Text printFreeze (Freeze deps (Flags flags)) =- concat [ "constraints: \n ", constraints, "\n"]+ T.concat [ "constraints:\n ", constraints, "\n"] where- constraints = intercalate "\n , " (constrait <$> sort deps)+ constraints = T.intercalate "\n , " (constrait <$> sort deps) constrait pkg =- let name = (pack . unPackageName . pkgName $ pkg)- ver = (pack . prettyShow . pkgVersion $ pkg)- base = concat [name, " ==", ver]- in case lookup name flags of+ let name = (T.pack . unPackageName . pkgName $ pkg)+ ver = (T.pack . prettyShow . pkgVersion $ pkg)+ base = T.concat [name, " ==", ver]+ in case M.lookup name flags of Nothing -> base- Just entries -> concat [ name, " ", (custom entries)- , "\n , ", base]- custom (toList -> lst) = intercalate " " $ (renderFlag <$> lst)+ Just entries -> T.concat [ name, " ", (custom entries)+ , "\n , ", base]+ custom (M.toList -> lst) = T.intercalate " " $ (renderFlag <$> lst) renderFlag (name, True) = "+" <> name renderFlag (name, False) = "-" <> name data Freeze = Freeze [PackageIdentifier] Flags deriving (Show) -genFreeze :: Resolver -> Freeze-genFreeze Resolver{deps, flags} =- let pkgs = unPkgId <$> mapMaybe pick deps+genFreeze :: Resolver -> [PackageName] -> Freeze+genFreeze Resolver{deps, flags} ignore =+ let pkgs = filter noSelfs $ unPkgId <$> mapMaybe pick deps uniqpkgs = nubOn pkgName pkgs in Freeze uniqpkgs flags where pick (Hackage p) = Just p pick (SourceDep _) = Nothing+ noSelfs (pkgName -> n) = notElem n ignore data Options = Options { input :: FilePath
stackage-to-hackage.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: stackage-to-hackage-version: 1.0.1+version: 1.0.2 synopsis: Convert stack.yaml to cabal.project + cabal.project.freeze license: GPL-3.0-or-later license-file: LICENSE