stackage-to-hackage 1.0.2 → 1.1.0
raw patch · 6 files changed
+418/−392 lines, 6 filesdep +http-clientdep +http-client-tlsdep +stackage-to-hackagedep −HsOpenSSLdep −http-streamsdep −network-uri
Dependencies added: http-client, http-client-tls, stackage-to-hackage
Dependencies removed: HsOpenSSL, http-streams, network-uri, semigroupoids
Files
- exe/Main.hs +48/−0
- lib/StackageToHackage/Hackage.hs +99/−0
- lib/StackageToHackage/Stackage.hs +244/−0
- src/Main.hs +0/−133
- src/Stackage.hs +0/−232
- stackage-to-hackage.cabal +27/−27
+ exe/Main.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad.Extra (ifM)+import qualified Data.ByteString as BS+import qualified Data.List.NonEmpty as NEL+import Data.Text.Encoding (encodeUtf8)+import Distribution.Types.PackageName (mkPackageName)+import qualified Options.Applicative as Opts+import StackageToHackage.Hackage (printFreeze, printProject,+ stackToCabal)+import StackageToHackage.Stackage (localDirs, readStack)+import System.Directory (doesDirectoryExist,+ listDirectory)+import System.FilePath (takeBaseName, takeDirectory,+ takeExtension, (</>))++main :: IO ()+main = do+ Options{input} <- Opts.execParser $+ Opts.info (Opts.helper <*> optionsParser) Opts.fullDesc+ stack <- readStack =<< BS.readFile input+ let dir = (takeDirectory input)+ subs = NEL.toList $ (dir </>) <$> localDirs stack+ cabals <- concat <$> traverse (globExt ".cabal") subs+ -- assumes that .cabal files are named correctly, otherwise we need+ -- PackageDescription-Parsec.html#v:readGenericPackageDescription+ let ignore = (mkPackageName . takeBaseName) <$> cabals+ (project, freeze) <- stackToCabal ignore dir stack+ 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++data Options = Options+ { input :: FilePath+ }+optionsParser :: Opts.Parser Options+optionsParser = Options+ <$> file+ where+ file = Opts.strArgument+ ( Opts.metavar "FILENAME"+ <> Opts.help "Input stack.yaml")
+ lib/StackageToHackage/Hackage.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- | A simplistic model of cabal multi-package files and convertors from Stackage.+module StackageToHackage.Hackage+ ( stackToCabal+ , Project(..), printProject+ , Freeze(..), printFreeze+ ) where++import Data.List (sort)+import Data.List.Extra (nubOn)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NEL+import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Semigroup (sconcat)+import Data.Text (Text)+import qualified Data.Text as T+import Distribution.Pretty (prettyShow)+import Distribution.Types.PackageId (PackageIdentifier (..))+import Distribution.Types.PackageName (PackageName, unPackageName)+import StackageToHackage.Stackage+import System.FilePath (addTrailingPathSeparator)++-- | Converts a stack.yaml (and list of local packages) to cabal.project and+-- cabal.project.freeze.+stackToCabal :: [PackageName] -> FilePath -> Stack -> IO (Project, Freeze)+stackToCabal ignore dir stack = do+ resolvers <- unroll dir stack+ let resolver = sconcat resolvers+ project = genProject stack resolver+ freeze = genFreeze resolver ignore+ pure (project, freeze)++-- TODO: something like stackToCabal that puts constraints into .cabal files++printProject :: Project -> Text+printProject (Project (Ghc ghc) pkgs srcs) =+ T.concat [ "-- Generated by stackage-to-hackage\n\n"+ , "with-compiler: ", ghc, "\n\n"+ , "packages:\n ", packages, "\n\n"+ , sources, "\n"+ , "allow-older: *\n"+ , "allow-newer: *\n"+ ]+ where+ packages = T.intercalate "\n , " (T.pack . addTrailingPathSeparator <$>+ NEL.toList pkgs)+ sources = T.intercalate "\n" (source =<< srcs)+ source Git{repo, commit, subdirs} =+ 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 -> T.concat [base, " subdir: ", d, "\n"]) <$> subdirs++data Project = Project Ghc (NonEmpty FilePath) [Git] deriving (Show)++genProject :: Stack -> Resolver -> Project+genProject stack Resolver{compiler, deps} = Project+ (fromMaybe (Ghc "ghc") compiler)+ (localDirs stack)+ (nubOn repo $ mapMaybe pickGit deps)+ where+ pickGit (Hackage _ ) = Nothing+ pickGit (SourceDep g) = Just g++printFreeze :: Freeze -> Text+printFreeze (Freeze deps (Flags flags)) =+ T.concat [ "constraints:\n ", constraints, "\n"]+ where+ constraints = T.intercalate "\n , " (constrait <$> sort deps)+ constrait pkg =+ 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 -> 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 -> [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
+ lib/StackageToHackage/Stackage.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Duplicates a subset of the Stack ADT. It'd be nice if we could just re-use+-- the actual ADT, but stack isn't available as a library that we can build from+-- Hackage.+module StackageToHackage.Stackage where++import Control.Applicative (Alternative, empty, (<|>))+import Control.Monad.Extra (loopM, unlessM)+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (toStrict)+import Data.List.NonEmpty (NonEmpty (..), head, nonEmpty,+ reverse, (<|))+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)+import Data.Text (Text, isSuffixOf, replace,+ takeWhile, unpack)+import Data.YAML (FromYAML, decodeStrict,+ parseYAML, withMap, withStr,+ (.!=), (.:), (.:?))+import Distribution.Text (simpleParse)+import Distribution.Types.PackageId (PackageIdentifier (..))+import Network.HTTP.Client (httpLbs, parseRequest,+ responseBody)+import Network.HTTP.Client.TLS (getGlobalManager)+import Prelude hiding (head, reverse, takeWhile)+import System.Directory (XdgDirectory (..),+ createDirectoryIfMissing,+ doesFileExist, getXdgDirectory)+import System.FilePath (takeDirectory, (</>))++data Stack = Stack+ { resolver :: ResolverRef+ , compiler :: Maybe Ghc+ , packages :: [Package]+ , extraDeps :: [Dep]+ , flags :: Flags+ -- TODO ghcOptions+ } deriving (Show)++localDirs :: Stack -> NonEmpty FilePath+localDirs Stack{packages} =+ fromMaybe (pure ".") $ nonEmpty $ mapMaybe locals packages+ where+ locals (Local p) = Just p+ locals (Location _) = Nothing++newtype Ghc = Ghc Text+ deriving (Show)+ deriving newtype (FromYAML)++data Package = Local FilePath+ | Location Git+ deriving (Show)++data Git = Git+ { repo :: Repo+ , commit :: Commit+ , subdirs :: [Subdir]+ } deriving (Show)+type Repo = Text+type Commit = Text+type Subdir = Text++data Resolver = Resolver+ { resolver :: Maybe ResolverRef+ , compiler :: Maybe Ghc+ , deps :: [Dep]+ , flags :: Flags+ } deriving (Show)+instance Semigroup Resolver where+ (Resolver r c p f) <> (Resolver r' c' p' f') =+ Resolver (r <|> r') (c <|> c') (p <> p') (f <> f')++-- TODO: remote ResolverRefs+data ResolverRef = Canned Text+ | Snapshot Text+ deriving (Show)++-- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Types-PackageId.html#t:PackageIdentifier+-- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Parsec-Class.html#v:simpleParsec++data Dep = Hackage PkgId+ | SourceDep Git+ deriving (Show)++newtype Flags = Flags (Map PkgName (Map FlagName Bool))+ deriving (Show)+ deriving newtype (FromYAML, Semigroup)++type PkgName = Text+type FlagName = Text++-- the format used at https://github.com/commercialhaskell/stackage-snapshots+-- which is similar to the Resolver format.+data NewResolver = NewResolver+ { compiler :: Ghc+ , packages :: [NewDep]+ , flags :: Flags+ } deriving (Show)++data NewDep = NewDep PkgId+ deriving (Show)++--------------------------------------------------------------------------------+-- Resolvers++readStack :: BS.ByteString -> IO Stack+readStack text = either fail pure $ decode1Strict text++type RelativeResolvers = NonEmpty (Maybe FilePath, Resolver)+type Resolvers = NonEmpty Resolver++-- highest priority resolver first+unroll :: FilePath -> Stack -> IO Resolvers+unroll base stack = do+ let stack' = stack2resolver stack+ reverse <$> (loopM next (pure (Just base, stack')))+ where+ -- lowest priority (deepest) resolver first+ next :: RelativeResolvers -> IO (Either RelativeResolvers Resolvers)+ next rs = case head rs of+ (_, Resolver Nothing _ _ _) -> pure $ Right (snd <$> rs)+ (dir, Resolver (Just r) _ _ _) -> (Left . (<| rs)) <$> resolve dir r++-- if the Resolver is a local snapshot, also include its dir+resolve :: Maybe FilePath -> ResolverRef -> IO (Maybe FilePath, Resolver)+resolve _ (Canned lts) = do+ cached <- cache lts+ text <- (BS.readFile cached) <|> download+ update cached text+ either fail (\r -> pure (Nothing, r)) $ new2old <$> (decode1Strict $ text)+ where+ download =+ let path = unpack $ replace "." "/" (replace "-" "/" lts)+ raw = concat ["https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/", path, ".yaml"]+ in do+ manager <- getGlobalManager+ url <- parseRequest raw+ putStrLn ("Downloading: " <> raw)+ resp <- httpLbs url manager+ pure $ toStrict $ responseBody resp++ update file content = unlessM (doesFileExist file) (BS.writeFile file content)++resolve (Just base) (Snapshot path) = do+ let file = base </> (unpack path)+ dir = takeDirectory file+ text <- BS.readFile file+ either fail (\r -> pure (Just dir, r)) $ decode1Strict text++resolve Nothing _ = fail "Remote snapshots can't use relative paths."++cache :: Text -> IO FilePath+cache file = do+ dir <- getXdgDirectory XdgCache "stackage"+ createDirectoryIfMissing True dir+ pure $ dir </> (unpack file)++stack2resolver :: Stack -> Resolver+stack2resolver Stack{resolver, compiler, packages, extraDeps, flags} =+ Resolver (Just resolver) compiler (sourcedeps <> extraDeps) flags+ where sourcedeps = mapMaybe pick packages+ pick (Local _) = Nothing+ pick (Location g) = Just . SourceDep $ g++new2old :: NewResolver -> Resolver+new2old NewResolver{compiler, packages, flags} =+ Resolver Nothing (Just compiler) (new2old' <$> packages) flags+ where+ new2old' (NewDep pkg) = Hackage pkg++--------------------------------------------------------------------------------+-- YAML boilerplate++-- https://github.com/haskell-hvr/HsYAML/pull/5+decode1Strict :: FromYAML a => BS.ByteString -> Either String a+decode1Strict text = do+ as <- decodeStrict text+ maybe (Left "expected unique") Right $ listToMaybe as++instance FromYAML Stack where+ parseYAML = withMap "Stack" $ \m -> Stack+ <$> m .: "resolver"+ <*> m .:? "compiler"+ <*> m .:? "packages" .!= mempty+ <*> m .:? "extra-deps" .!= mempty+ <*> m .:? "flags" .!= (Flags M.empty)++instance FromYAML Git where+ parseYAML = withMap "Git" $ \m -> Git+ <$> m .: "git"+ <*> m .: "commit"+ <*> m .:? "subdirs" .!= []++instance FromYAML ResolverRef where+ parseYAML = withStr "ResolverRef" $ \s ->+ if isSuffixOf ".yaml" s+ then (pure . Snapshot) s+ else (pure . Canned) s++instance FromYAML Package where+ parseYAML n = (local n) <|> (location n)+ where+ local = withStr "Local" $ pure . Local . unpack+ location = withMap "Location" $ \m ->+ Location <$> m .: "location"++instance FromYAML Dep where+ parseYAML n = hackage <|> source+ where+ hackage = Hackage <$> parseYAML n+ source = SourceDep <$> parseYAML n++instance FromYAML Resolver where+ parseYAML = withMap "Resolver" $ \m -> Resolver+ <$> m .:? "resolver"+ <*> m .:? "compiler"+ <*> m .:? "packages" .!= mempty+ <*> m .:? "flags" .!= (Flags M.empty)++instance FromYAML NewDep where+ parseYAML = withMap "NewDep" $ \m -> hackage' =<< m .: "hackage"+ where+ hackage' n = NewDep <$> parseYAML n++instance FromYAML NewResolver where+ parseYAML = withMap "NewResolver" $ \m -> NewResolver+ <$> m .: "compiler"+ <*> m .:? "packages" .!= mempty+ <*> m .:? "flags" .!= (Flags M.empty)++newtype PkgId = PkgId { unPkgId :: PackageIdentifier } deriving (Show)+instance FromYAML PkgId where+ parseYAML = withStr "PackageIdentifier" $ \s ->+ PkgId <$> (hoistMaybe . simpleParse . unpack) (takeWhile ('@' /=) s)++hoistMaybe :: Alternative m => Maybe a -> m a+hoistMaybe = maybe empty pure
− src/Main.hs
@@ -1,133 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# 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.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)-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import Distribution.Pretty (prettyShow)-import Distribution.Types.PackageId (PackageIdentifier (..))-import Distribution.Types.PackageName (PackageName, mkPackageName,- unPackageName)-import OpenSSL (withOpenSSL)-import qualified Options.Applicative as Opts-import Stackage-import System.Directory (doesDirectoryExist,- listDirectory)-import System.FilePath (addTrailingPathSeparator,- takeBaseName, takeDirectory,- takeExtension, (</>))--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)- resolvers <- unroll dir stack- let- resolver = fold1 resolvers- 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) =- T.concat [ "-- Generated by stackage-to-hackage from stack.yaml\n\n"- , "with-compiler: ", ghc, "\n\n"- , "packages:\n ", packages, "\n\n"- , sources, "\n"- , "allow-older: *\n"- , "allow-newer: *\n"- ]- where- packages = T.intercalate "\n , " (T.pack . addTrailingPathSeparator <$>- NEL.toList pkgs)- sources = T.intercalate "\n" (source =<< srcs)- source Git{repo, commit, subdirs} =- 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 -> T.concat [base, " subdir: ", d, "\n"]) <$> subdirs--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)- (fromMaybe (pure ".") (nonEmpty $ mapMaybe pickLocal packages))- (nubOn repo $ mapMaybe pickGit deps)- where- pickLocal (Local p) = Just p- pickLocal (Location _) = Nothing- pickGit (Hackage _ ) = Nothing- pickGit (SourceDep g) = Just g--printFreeze :: Freeze -> Text-printFreeze (Freeze deps (Flags flags)) =- T.concat [ "constraints:\n ", constraints, "\n"]- where- constraints = T.intercalate "\n , " (constrait <$> sort deps)- constrait pkg =- 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 -> 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 -> [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- }-optionsParser :: Opts.Parser Options-optionsParser = Options- <$> file- where- file = Opts.strArgument- ( Opts.metavar "FILENAME"- <> Opts.help "Input stack.yaml")
− src/Stackage.hs
@@ -1,232 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}---- Duplicates a subset of the Stack ADT. It'd be nice if we could just re-use--- the actual ADT, but stack isn't available as a library that we can build from--- Hackage.-module Stackage where--import Control.Applicative ((<|>))-import Control.Monad.Extra (loopM, unlessM)-import qualified Data.ByteString as BS-import Data.ByteString.Char8 (pack)-import Data.List.NonEmpty (NonEmpty (..), head, reverse,- (<|))-import Data.Map.Strict (Map, empty)-import Data.Maybe (listToMaybe, mapMaybe)-import Data.Text (Text, concat, isSuffixOf,- replace, takeWhile, unpack)-import Data.YAML (FromYAML, decodeStrict,- parseYAML, withMap, withStr,- (.!=), (.:), (.:?))-import Distribution.Text (simpleParse)-import Distribution.Types.PackageId (PackageIdentifier (..))-import qualified Network.Http.Client as Http-import Network.URI (parseURI)-import Options.Applicative.Internal (hoistMaybe)-import Prelude hiding (concat, head, reverse,- takeWhile)-import System.Directory (XdgDirectory (..),- createDirectoryIfMissing,- doesFileExist, getXdgDirectory)-import System.FilePath (takeDirectory, (</>))--data Stack = Stack- { resolver :: ResolverRef- , compiler :: Maybe Ghc- , packages :: [Package]- , extraDeps :: [Dep]- , flags :: Flags- -- TODO ghcOptions- } deriving (Show)--newtype Ghc = Ghc Text- deriving (Show)- deriving newtype (FromYAML)--data Package = Local FilePath- | Location Git- deriving (Show)--data Git = Git- { repo :: Repo- , commit :: Commit- , subdirs :: [Subdir]- } deriving (Show)-type Repo = Text-type Commit = Text-type Subdir = Text--data Resolver = Resolver- { resolver :: Maybe ResolverRef- , compiler :: Maybe Ghc- , deps :: [Dep]- , flags :: Flags- } deriving (Show)-instance Semigroup Resolver where- (Resolver r c p f) <> (Resolver r' c' p' f') =- Resolver (r <|> r') (c <|> c') (p <> p') (f <> f')---- TODO: remote ResolverRefs-data ResolverRef = Canned Text- | Snapshot Text- deriving (Show)---- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Types-PackageId.html#t:PackageIdentifier--- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Parsec-Class.html#v:simpleParsec--data Dep = Hackage PkgId- | SourceDep Git- deriving (Show)--newtype Flags = Flags (Map PkgName (Map FlagName Bool))- deriving (Show)- deriving newtype (FromYAML, Semigroup)--type PkgName = Text-type FlagName = Text---- the format used at https://github.com/commercialhaskell/stackage-snapshots--- which is similar to the Resolver format.-data NewResolver = NewResolver- { compiler :: Ghc- , packages :: [NewDep]- , flags :: Flags- } deriving (Show)--data NewDep = NewDep PkgId- deriving (Show)------------------------------------------------------------------------------------- Resolvers--readStack :: BS.ByteString -> IO Stack-readStack text = either fail pure $ decode1Strict text--type RelativeResolvers = NonEmpty (Maybe FilePath, Resolver)-type Resolvers = NonEmpty Resolver---- highest priority resolver first-unroll :: FilePath -> Stack -> IO Resolvers-unroll base stack = do- let stack' = stack2resolver stack- reverse <$> (loopM next (pure (Just base, stack')))- where- -- lowest priority (deepest) resolver first- next :: RelativeResolvers -> IO (Either RelativeResolvers Resolvers)- next rs = case head rs of- (_, Resolver Nothing _ _ _) -> pure $ Right (snd <$> rs)- (dir, Resolver (Just r) _ _ _) -> (Left . (<| rs)) <$> resolve dir r---- if the Resolver is a local snapshot, also include its dir-resolve :: Maybe FilePath -> ResolverRef -> IO (Maybe FilePath, Resolver)-resolve _ (Canned lts) = do- cached <- cache lts- text <- (BS.readFile cached) <|> download- update cached text- either fail (\r -> pure (Nothing, r)) $ new2old <$> (decode1Strict $ text)- where- download =- let path = replace "." "/" (replace "-" "/" lts)- raw = concat ["https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/", path, ".yaml"]- in do- url <- maybe (fail "invalid URL") pure (parseURI $ unpack raw)- putStrLn ("Downloading: " <> (show url))- Http.get (pack $ show url) Http.concatHandler-- update file content = unlessM (doesFileExist file) (BS.writeFile file content)--resolve (Just base) (Snapshot path) = do- let file = base </> (unpack path)- dir = takeDirectory file- text <- BS.readFile file- either fail (\r -> pure (Just dir, r)) $ decode1Strict text--resolve Nothing _ = fail "Remote snapshots can't use relative paths."--cache :: Text -> IO FilePath-cache file = do- dir <- getXdgDirectory XdgCache "stackage"- createDirectoryIfMissing True dir- pure $ dir </> (unpack file)--stack2resolver :: Stack -> Resolver-stack2resolver Stack{resolver, compiler, packages, extraDeps, flags} =- Resolver (Just resolver) compiler (sourcedeps <> extraDeps) flags- where sourcedeps = mapMaybe pick packages- pick (Local _) = Nothing- pick (Location g) = Just . SourceDep $ g--new2old :: NewResolver -> Resolver-new2old NewResolver{compiler, packages, flags} =- Resolver Nothing (Just compiler) (new2old' <$> packages) flags- where- new2old' (NewDep pkg) = Hackage pkg------------------------------------------------------------------------------------- YAML boilerplate---- https://github.com/haskell-hvr/HsYAML/pull/5-decode1Strict :: FromYAML a => BS.ByteString -> Either String a-decode1Strict text = do- as <- decodeStrict text- maybe (Left "expected unique") Right $ listToMaybe as--instance FromYAML Stack where- parseYAML = withMap "Stack" $ \m -> Stack- <$> m .: "resolver"- <*> m .:? "compiler"- <*> m .:? "packages" .!= mempty- <*> m .:? "extra-deps" .!= mempty- <*> m .:? "flags" .!= (Flags empty)--instance FromYAML Git where- parseYAML = withMap "Git" $ \m -> Git- <$> m .: "git"- <*> m .: "commit"- <*> m .:? "subdirs" .!= []--instance FromYAML ResolverRef where- parseYAML = withStr "ResolverRef" $ \s ->- if isSuffixOf ".yaml" s- then (pure . Snapshot) s- else (pure . Canned) s--instance FromYAML Package where- parseYAML n = (local n) <|> (location n)- where- local = withStr "Local" $ pure . Local . unpack- location = withMap "Location" $ \m ->- Location <$> m .: "location"--instance FromYAML Dep where- parseYAML n = hackage <|> source- where- hackage = Hackage <$> parseYAML n- source = SourceDep <$> parseYAML n--instance FromYAML Resolver where- parseYAML = withMap "Resolver" $ \m -> Resolver- <$> m .:? "resolver"- <*> m .:? "compiler"- <*> m .:? "packages" .!= mempty- <*> m .:? "flags" .!= (Flags empty)--instance FromYAML NewDep where- parseYAML = withMap "NewDep" $ \m -> hackage' =<< m .: "hackage"- where- hackage' n = NewDep <$> parseYAML n--instance FromYAML NewResolver where- parseYAML = withMap "NewResolver" $ \m -> NewResolver- <$> m .: "compiler"- <*> m .:? "packages" .!= mempty- <*> m .:? "flags" .!= (Flags empty)--newtype PkgId = PkgId { unPkgId :: PackageIdentifier } deriving (Show)-instance FromYAML PkgId where- parseYAML = withStr "PackageIdentifier" $ \s ->- PkgId <$> (hoistMaybe . simpleParse . unpack) (takeWhile ('@' /=) s)
stackage-to-hackage.cabal view
@@ -1,51 +1,51 @@ cabal-version: 2.2 name: stackage-to-hackage-version: 1.0.2+version: 1.1.0 synopsis: Convert stack.yaml to cabal.project + cabal.project.freeze license: GPL-3.0-or-later license-file: LICENSE author: Tseen She maintainer: Tseen She copyright: 2018 Tseen She-bug-reports: https://gitlab.com/tseenshe/stackage-to-hackage/merge_requests-tested-with: GHC ^>= 8.4.4 || ^>= 8.6.2+bug-reports: https://gitlab.com/tseenshe/stack2cabal/merge_requests+tested-with: GHC ^>= 8.4.4 || ^>= 8.6.3 category: Building description:- This is a small tool to create a cabal.project and cabal.project.freeze file- for an existing Haskell application that has its build plan defined for- the stack build tool.-- The following convenience script invokes stackage-to-hackage and hpack- together [stack2cabal](https://gitlab.com/tseenshe/stackage-to-hackage/blob/master/stack2cabal).--source-repository head- type: git- location: https://gitlab.com/tseenshe/stackage-to-hackage+ A small library (and demo app) to convert stack.yaml files to cabal.project /+ cabal.project.freeze for an existing Haskell application that has its build plan+ defined for the stack build tool.+ .+ Users will want to use the stack2cabal application, integrating hpack support. -- https://www.haskell.org/cabal/users-guide/cabal-projectindex.html common deps build-depends: , base ^>= 4.11.1.0 || ^>= 4.12.0.0+ , bytestring ^>= 0.10.8.2+ , Cabal ^>= 2.4.1.0+ , containers ^>= 0.6.0.1+ , directory ^>= 1.3.3.1+ , extra ^>= 1.6.13+ , filepath ^>= 1.4.2.1+ , text ^>= 1.2.3.1 ghc-options: -Wall -Werror=missing-home-modules default-language: Haskell2010 +library+ import: deps+ hs-source-dirs: lib+ exposed-modules: StackageToHackage.Hackage+ , StackageToHackage.Stackage+ build-depends: , HsYAML ^>= 0.1.1.2+ -- http-client, not http-streams, to match hpack+ , http-client ^>= 0.5.14+ , http-client-tls ^>= 0.3.5.3+ executable stackage-to-hackage import: deps- hs-source-dirs: src+ hs-source-dirs: exe main-is: Main.hs- other-modules: Stackage- build-depends: , Cabal ^>= 2.4.1.0- , HsYAML ^>= 0.1.1.2- , HsOpenSSL ^>= 0.11.4.15- , bytestring ^>= 0.10.8.2- , http-streams ^>= 0.8.6.1- , containers ^>= 0.6.0.1- , directory ^>= 1.3.3.1- , extra ^>= 1.6.13- , filepath ^>= 1.4.2.1+ build-depends: stackage-to-hackage , optparse-applicative ^>= 0.14.3.0- , network-uri ^>= 2.6.1.0- , semigroupoids ^>= 5.3.1- , text ^>= 1.2.3.1 ghc-options: -threaded