diff --git a/nix-tools.cabal b/nix-tools.cabal index bcc1893..b93b76f 100644 --- a/nix-tools.cabal +++ b/nix-tools.cabal @@ -18,7 +18,7 @@ library , Cabal2Nix.Util , Cabal2Nix.Plan , Distribution.Nixpkgs.Fetch - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , hnix >= 0.5.0 , aeson , unordered-containers @@ -40,7 +40,7 @@ library executable cabal-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , transformers , bytestring , hpack @@ -56,7 +56,7 @@ executable cabal-to-nix executable hashes-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , hnix >= 0.5.0 , nix-tools , data-fix @@ -72,7 +72,7 @@ executable hashes-to-nix executable plan-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , nix-tools , hnix >= 0.5.0 , text @@ -87,7 +87,7 @@ executable plan-to-nix executable hackage-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , nix-tools , hackage-db , hnix @@ -106,7 +106,7 @@ executable hackage-to-nix executable lts-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , nix-tools , hnix >= 0.5.0 , yaml @@ -124,7 +124,13 @@ executable lts-to-nix executable stack-to-nix ghc-options: -Wall main-is: Main.hs - build-depends: base >=4.11 && <4.12 + other-modules: Stack2nix + , Stack2nix.Cache + , Stack2nix.CLI + , Stack2nix.External.Resolve + , Stack2nix.Project + , Stack2nix.Stack + build-depends: base >=4.11 && <4.13 , nix-tools , transformers , hnix >= 0.5.0 diff --git a/stack2nix/Main.hs b/stack2nix/Main.hs index 1a911bf..76a231d 100644 --- a/stack2nix/Main.hs +++ b/stack2nix/Main.hs @@ -1,433 +1,7 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} module Main where -import System.Environment (getArgs) - -import Nix.Pretty (prettyNix) -import Nix.Expr - -import Distribution.Types.PackageName -import Distribution.Types.PackageId -import Distribution.Compat.ReadP hiding (Parser) -import Distribution.Text -import Distribution.Simple.Utils (shortRelativePath) -import Distribution.Types.Version (nullVersion) - -import Data.Yaml hiding (Parser) -import Data.String (fromString) -import qualified Data.Text as T - -import Data.Aeson -import Lens.Micro -import Lens.Micro.Aeson - -import Data.Vector (toList) - -import System.Directory -import System.FilePath -import Control.Monad - -import Cabal2Nix hiding (Git) -import qualified Cabal2Nix as C2N -import Cabal2Nix.Util - -import Data.Text.Prettyprint.Doc (Doc) -import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc) -import System.IO -import Data.List (isSuffixOf, isInfixOf, isPrefixOf) -import Control.Applicative ((<|>)) - -import Distribution.Nixpkgs.Fetch -import Control.Monad.Extra -import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe -import Control.Exception (catch, SomeException(..)) - -import qualified Hpack -import qualified Hpack.Config as Hpack -import qualified Hpack.Render as Hpack -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.List.NonEmpty ( NonEmpty (..) ) -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (toStrict) - -import Options.Applicative hiding (option) -import Data.Semigroup ((<>)) - -import Network.HTTP.Client -import Network.HTTP.Client.TLS -import Network.HTTP.Types.Status (ok200) -import Control.Exception.Base (SomeException(..),PatternMatchFail(..)) - --------------------------------------------------------------------------------- --- CLI Arguments -data Args = Args - { outputPath :: FilePath - , stackFile :: FilePath - } deriving Show - --- Argument Parser -args :: Parser Args -args = Args - <$> strOption ( long "output" <> short 'o' <> metavar "DIR" <> value "." <> help "Generate output in DIR" ) - <*> argument str ( metavar "stack.yaml" ) - - --------------------------------------------------------------------------------- --- The stack.yaml file --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- packages --- --- * (1) Paths --- - ./site1 --- - ./site2 --- * (2) Git Locations --- - location: --- git: https://github.com/yesodweb/yesod --- commit: 7038ae6317cb3fe4853597633ba7a40804ca9a46 --- extra-dep: true --- subdirs: --- - yesod-core --- - yesod-bin - --------------------------------------------------------------------------------- --- extra-deps --- --- * (1) Package index (optional sha of cabal files contents; or revision number) --- - acme-missiles-0.3 --- - acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1 --- - acme-missiles-0.3@rev:0 --- --- * (2) Local File Path (foo-1.2.3 would be parsed as a package index) --- - vendor/somelib --- - ./foo-1.2.3 --- --- * (3) Git and Mercurial repos (optional subdirs; or github) --- - git: git@github.com:commercialhaskell/stack.git --- commit: 6a86ee32e5b869a877151f74064572225e1a0398 --- - git: git@github.com:snoyberg/http-client.git --- commit: "a5f4f3" --- - hg: https://example.com/hg/repo --- commit: da39a3ee5e6b4b0d3255bfef95601890afd80709 --- - git: git@github.com:yesodweb/wai --- commit: 2f8a8e1b771829f4a8a77c0111352ce45a14c30f --- subdirs: --- - auto-update --- - wai --- - github: snoyberg/http-client --- commit: a5f4f30f01366738f913968163d856366d7e0342 --- --- * (4) Archives (HTTP(S) or local filepath) --- - https://example.com/foo/bar/baz-0.0.2.tar.gz --- - archive: http://github.com/yesodweb/wai/archive/2f8a8e1b771829f4a8a77c0111352ce45a14c30f.zip --- subdirs: --- - wai --- - warp --- - archive: ../acme-missiles-0.3.tar.gz --- sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b - --- NOTE: We will only parse a suitable subset of the stack.yaml file. - --------------------------------------------------------------------------------- --- Some generic types -type Resolver = String -type Name = String -type Compiler = String -type Sha256 = String -type CabalRev = Int -- cabal revision 0,1,2,... -type URL = String -- Git/Hg/... URL -type Rev = String -- Git revision - --------------------------------------------------------------------------------- --- Data Types --- Dependencies are the merged set of packages and extra-deps. --- As we do not distinguish them in the same way stack does, we --- can get away with this. -data Dependency - = PkgIndex PackageIdentifier (Maybe (Either Sha256 CabalRev)) -- ^ overridden package in the stackage index - | LocalPath String -- ^ Some local package (potentially overriding a package in the index as well) - | DVCS Location [FilePath] -- ^ One or more packages fetched from git or similar. - -- TODO: Support archives. - -- | Archive ... - deriving (Show) - -data Stack - = Stack Resolver (Maybe Compiler) [Dependency] - deriving (Show) - --- stack supports custom snapshots --- https://docs.haskellstack.org/en/stable/custom_snapshot/ -data StackSnapshot - = Snapshot - Resolver -- lts-XX.YY/nightly-... - (Maybe Compiler) -- possible compiler override for the snapshot - Name -- name - [Dependency] -- packages - -- [Package -> [Flag]] -- flags - -- [PackageName] -- drop-packages - -- [PackageName -> Bool] -- hidden - -- [package -> [Opt]] -- ghc-options - deriving (Show) - -data Location - = Git URL Rev - | HG URL Rev - deriving (Show) - - --------------------------------------------------------------------------------- --- Parsers for package indices -sha256Suffix :: ReadP r Sha256 -sha256Suffix = string "@sha256:" *> many1 (satisfy (`elem` (['0'..'9']++['a'..'z']++['A'..'Z']))) - -revSuffix :: ReadP r CabalRev -revSuffix = string "@rev:" *> (read <$> many1 (satisfy (`elem` ['0'..'9']))) - -suffix :: ReadP r (Maybe (Either Sha256 CabalRev)) -suffix = option Nothing (Just <$> (Left <$> sha256Suffix) +++ (Right <$> revSuffix)) - -pkgIndex :: ReadP r Dependency -pkgIndex = PkgIndex <$> parse <*> suffix <* eof - --------------------------------------------------------------------------------- --- JSON/YAML destructors - -instance FromJSON Location where - parseJSON = withObject "Location" $ \l -> Git - <$> l .: "git" - <*> l .: "commit" - -instance FromJSON Stack where - parseJSON = withObject "Stack" $ \s -> Stack - <$> s .: "resolver" - <*> s .:? "compiler" .!= Nothing - <*> ((<>) <$> s .:? "packages" .!= [] - <*> s .:? "extra-deps" .!= []) - -instance FromJSON StackSnapshot where - parseJSON = withObject "Snapshot" $ \s -> Snapshot - <$> s .: "resolver" - <*> s .:? "compiler" .!= Nothing - <*> s .: "name" - <*> s .:? "packages" .!= [] - -instance FromJSON Dependency where - -- Note: we will parse foo-X.Y.Z as a package. - -- if we want it to be a localPath, it needs - -- to be ./foo-X.Y.Z - parseJSON p = parsePkgIndex p <|> parseLocalPath p <|> parseDVCS p - where parsePkgIndex = withText "Package Index" $ \pi -> - case [pi' | (pi',"") <- readP_to_S pkgIndex (T.unpack pi)] of - -- Cabal will happily parse "foo" as a packageIdentifier, - -- we however are only interested in those that have a version - -- as well. Any valid version is larger than @nullVersion@, as - -- such we can use that as a filter. - [pi'@(PkgIndex pkgIdent _)] | pkgVersion pkgIdent > nullVersion -> return $ pi' - _ -> fail $ "invalid package index: " ++ show pi - parseLocalPath = withText "Local Path" $ - return . LocalPath . dropTrailingSlash . T.unpack - parseDVCS = withObject "DVCS" $ \o -> DVCS - <$> (o .: "location" <|> parseJSON p) - <*> o .:? "subdirs" .!= ["."] - - -- drop trailing slashes. Nix doesn't like them much; - -- stack doesn't seem to care. - dropTrailingSlash p | "/" `isSuffixOf` p = take (length p - 1) p - dropTrailingSlash p = p - --------------------------------------------------------------------------------- +import Stack2nix (doStack2nix) +import Stack2nix.CLI (parseStack2nixArgs) main :: IO () -main = print . prettyNix =<< stackexpr =<< execParser opts - where opts = info (args <**> helper) - ( fullDesc - <> progDesc "Generate a nix expression from a stack.yaml file" - <> header "stack-to-nix - a stack to nix converter" ) - -writeDoc :: FilePath -> Doc ann -> IO () -writeDoc file doc = - do handle <- openFile file WriteMode - hPutDoc handle doc - hClose handle - --- | A @resolver@ value in a stack.yaml file may point to an URL. As such --- we need to be able to fetch one. -decodeURLEither :: FromJSON a => String -> IO (Either ParseException a) -decodeURLEither url - | not (("http://" `isPrefixOf` url) || ("https://" `isPrefixOf` url)) - = return . Left . OtherParseException . SomeException . PatternMatchFail $ "No http or https prefix" - | otherwise = do - manager <- newManager tlsManagerSettings - request <- parseRequest url - response <- httpLbs request manager - unless (ok200 == responseStatus response) $ error ("failed to download " ++ url) - return . decodeEither' . toStrict $ responseBody response - - --- | If a stack.yaml file contains a @resolver@ that points to --- a file, resolve that file and merge the snapshot into the --- @Stack@ record. -resolveSnapshot :: Stack -> IO Stack -resolveSnapshot stack@(Stack resolver compiler pkgs) - = if ".yaml" `isSuffixOf` resolver - then do evalue <- if ("http://" `isPrefixOf` resolver) || ("https://" `isPrefixOf` resolver) - then decodeURLEither resolver - else decodeFileEither resolver - case evalue of - Left e -> error (show e) - Right (Snapshot resolver' compiler' _name pkgs') -> - pure $ Stack resolver' (compiler' <|> compiler) (pkgs <> pkgs') - else pure stack - -stackexpr :: Args -> IO NExpr -stackexpr args = - do evalue <- decodeFileEither (stackFile args) - case evalue of - Left e -> error (show e) - Right value -> stack2nix args - =<< resolveSnapshot value - -stack2nix :: Args -> Stack -> IO NExpr -stack2nix args stack@(Stack resolver compiler _) = - do let extraDeps = extraDeps2nix stack - let _f_ = mkSym "f" - _import_ = mkSym "import" - _mkForce_ = mkSym "mkForce" - _isFunction_ = mkSym "isFunction" - _mapAttrs_ = mkSym "mapAttrs" - _config_ = mkSym "config" - packages <- packages2nix args stack - return . mkNonRecSet $ - [ "overlay" $= ("hackage" ==> mkNonRecSet - ([ "packages" $= (extraDeps $// packages) ] - ++ [ "compiler.version" $= fromString (quoted ver) - | (Just c) <- [compiler], let ver = filter (`elem` (".0123456789" :: [Char])) c] - ++ [ "compiler.nix-name" $= fromString (quoted name) - | (Just c) <- [compiler], let name = filter (`elem` ((['a'..'z']++['0'..'9']) :: [Char])) c])) - , "resolver" $= fromString (quoted resolver) - ] ++ [ - "compiler" $= fromString (quoted c) | (Just c) <- [compiler] - ] --- | Transform simple package index expressions --- The idea is to turn --- --- - name-version[@rev:N | @sha256:SHA] --- --- into --- --- { name.revision = hackage.name.version.revisions.default; } --- -extraDeps2nix :: Stack -> NExpr -extraDeps2nix (Stack _ _ pkgs) = - let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs] - in mkNonRecSet $ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. "default") - | (PackageIdentifier pkg ver, Nothing) <- extraDeps ] - ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. quoted (T.pack sha)) - | (PackageIdentifier pkg ver, (Just (Left sha))) <- extraDeps ] - ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. toText revNo) - | (PackageIdentifier pkg ver, (Just (Right revNo))) <- extraDeps ] - where parsePackageIdentifier :: String -> Maybe PackageIdentifier - parsePackageIdentifier = simpleParse - toText :: Text a => a -> T.Text - toText = fromString . show . disp - -findCabalFiles :: FilePath -> IO [CabalFile] -findCabalFiles path = doesFileExist (path Hpack.packageConfig) >>= \case - False -> fmap (OnDisk . (path )) . filter (isSuffixOf ".cabal") <$> listDirectory path - True -> do - mbPkg <- Hpack.readPackageConfig Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = path Hpack.packageConfig} - case mbPkg of - Left e -> error e - Right r -> - return $ [InMemory (Just Hpack) - (Hpack.decodeResultCabalFile r) - (encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))] - - where encodeUtf8 :: String -> ByteString - encodeUtf8 = T.encodeUtf8 . T.pack - -readCache :: IO [( String -- url - , String -- rev - , String -- subdir - , String -- sha256 - , String -- pkgname - , String -- nixexpr-path - )] -readCache = fmap (toTuple . words) . lines <$> readFile ".stack-to-nix.cache" - where toTuple [ url, rev, subdir, sha256, pkgname, exprPath ] - = ( url, rev, subdir, sha256, pkgname, exprPath ) - -appendCache :: String -> String -> String -> String -> String -> String -> IO () -appendCache url rev subdir sha256 pkgname exprPath = do - appendFile ".stack-to-nix.cache" $ unwords [ url, rev, subdir, sha256, pkgname, exprPath ] - appendFile ".stack-to-nix.cache" "\n" - -cacheHits :: String -> String -> String -> IO [ (String, String) ] -cacheHits url rev subdir - = do cache <- catch' readCache (const (pure [])) - return [ ( pkgname, exprPath ) - | ( url', rev', subdir', sha256, pkgname, exprPath ) <- cache - , url == url' - , rev == rev' - , subdir == subdir' ] - where catch' :: IO a -> (SomeException -> IO a) -> IO a - catch' = catch - --- makeRelativeToCurrentDirectory -packages2nix :: Args -> Stack-> IO NExpr -packages2nix args (Stack _ _ pkgs) = - do cwd <- getCurrentDirectory - fmap (mkNonRecSet . concat) . forM pkgs $ \case - (LocalPath folder) -> - do cabalFiles <- findCabalFiles (dropFileName (stackFile args) folder) - forM cabalFiles $ \cabalFile -> - let pkg = cabalFilePkgName cabalFile - nix = ".stack.nix" pkg <.> "nix" - nixFile = outputPath args nix - src = Just . C2N.Path $ relPath ".." folder - in do createDirectoryIfMissing True (takeDirectory nixFile) - writeDoc nixFile =<< - prettyNix <$> cabal2nix src cabalFile - return $ fromString pkg $= mkPath False nix - (DVCS (Git url rev) subdirs) -> - fmap concat . forM subdirs $ \subdir -> - do cacheHits <- liftIO $ cacheHits url rev subdir - case cacheHits of - [] -> do - fetch (\dir -> cabalFromPath url rev subdir $ dir subdir) - (Source url rev UnknownHash subdir) >>= \case - (Just (DerivationSource{..}, genBindings)) -> genBindings derivHash - _ -> return [] - hits -> - forM hits $ \( pkg, nix ) -> do - return $ fromString pkg $= mkPath False nix - _ -> return [] - where relPath = shortRelativePath (outputPath args) (dropFileName (stackFile args)) - cabalFromPath - :: String -- URL - -> String -- Revision - -> FilePath -- Subdir - -> FilePath -- Local Directory - -> MaybeT IO (String -> IO [Binding NExpr]) - cabalFromPath url rev subdir path = do - d <- liftIO $ doesDirectoryExist path - unless d $ fail ("not a directory: " ++ path) - cabalFiles <- liftIO $ findCabalFiles path - return $ \sha256 -> - forM cabalFiles $ \cabalFile -> do - let pkg = cabalFilePkgName cabalFile - nix = ".stack.nix" pkg <.> "nix" - nixFile = outputPath args nix - subdir' = if subdir == "." then Nothing - else Just subdir - src = Just $ C2N.Git url rev (Just sha256) subdir' - createDirectoryIfMissing True (takeDirectory nixFile) - writeDoc nixFile =<< - prettyNix <$> cabal2nix src cabalFile - liftIO $ appendCache url rev subdir sha256 pkg nix - return $ fromString pkg $= mkPath False nix +main = parseStack2nixArgs >>= doStack2nix diff --git a/stack2nix/Stack2nix.hs b/stack2nix/Stack2nix.hs new file mode 100644 index 0000000..8cd35bc --- /dev/null +++ b/stack2nix/Stack2nix.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE LambdaCase, RecordWildCards, OverloadedStrings #-} + +module Stack2nix + ( doStack2nix + , stackexpr + , stack2nix + ) where + +import qualified Data.Text as T +import Data.String (fromString) + +import Control.Monad.Trans.Maybe +import Control.Monad.IO.Class (liftIO) +import Control.Monad (unless, forM) +import Extra (unlessM) + +import System.FilePath ((<.>), (), takeDirectory, dropFileName) +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory) +import System.IO (IOMode(..), openFile, hClose) +import Data.Yaml (decodeFileEither) + +import Nix.Expr +import Nix.Pretty (prettyNix) +import Data.Text.Prettyprint.Doc (Doc) +import Data.Text.Prettyprint.Doc.Render.Text (hPutDoc) + +import Distribution.Types.PackageId (PackageIdentifier(..)) +import Distribution.Nixpkgs.Fetch (DerivationSource(..), Source(..), Hash(..), fetch) +import Distribution.Simple.Utils (shortRelativePath) +import Distribution.Text (Text(..), simpleParse) + +import Cabal2Nix hiding (Git) +import qualified Cabal2Nix as C2N +import Cabal2Nix.Util + +import Stack2nix.Cache (appendCache, cacheHits) +import Stack2nix.CLI (Args(..)) +import Stack2nix.Project +import Stack2nix.Stack (Stack(..), Dependency(..), Location(..)) +import Stack2nix.External.Resolve + +doStack2nix :: Args -> IO () +doStack2nix args = do + let pkgsNix = argOutputDir args "pkgs.nix" + defaultNix = argOutputDir args "default.nix" + pkgs <- stackexpr args + writeDoc pkgsNix (prettyNix pkgs) + unlessM (doesFileExist defaultNix) $ do + writeFile defaultNix defaultNixContents + +stackexpr :: Args -> IO NExpr +stackexpr args = + do evalue <- decodeFileEither (argStackYaml args) + case evalue of + Left e -> error (show e) + Right value -> stack2nix args + =<< resolveSnapshot value + +stack2nix :: Args -> Stack -> IO NExpr +stack2nix args stack@(Stack resolver compiler _) = + do let extraDeps = extraDeps2nix stack + let _f_ = mkSym "f" + _import_ = mkSym "import" + _mkForce_ = mkSym "mkForce" + _isFunction_ = mkSym "isFunction" + _mapAttrs_ = mkSym "mapAttrs" + _config_ = mkSym "config" + packages <- packages2nix args stack + return . mkNonRecSet $ + [ "overlay" $= ("hackage" ==> mkNonRecSet + ([ "packages" $= (extraDeps $// packages) ] + ++ [ "compiler.version" $= fromString (quoted ver) + | (Just c) <- [compiler], let ver = filter (`elem` (".0123456789" :: [Char])) c] + ++ [ "compiler.nix-name" $= fromString (quoted name) + | (Just c) <- [compiler], let name = filter (`elem` ((['a'..'z']++['0'..'9']) :: [Char])) c])) + , "resolver" $= fromString (quoted resolver) + ] ++ [ + "compiler" $= fromString (quoted c) | (Just c) <- [compiler] + ] +-- | Transform simple package index expressions +-- The idea is to turn +-- +-- - name-version[@rev:N | @sha256:SHA] +-- +-- into +-- +-- { name.revision = hackage.name.version.revisions.default; } +-- +extraDeps2nix :: Stack -> NExpr +extraDeps2nix (Stack _ _ pkgs) = + let extraDeps = [(pkgId, info) | PkgIndex pkgId info <- pkgs] + in mkNonRecSet $ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. "default") + | (PackageIdentifier pkg ver, Nothing) <- extraDeps ] + ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. quoted (T.pack sha)) + | (PackageIdentifier pkg ver, (Just (Left sha))) <- extraDeps ] + ++ [ (quoted (toText pkg)) $= (mkSym "hackage" @. toText pkg @. quoted (toText ver) @. "revisions" @. toText revNo) + | (PackageIdentifier pkg ver, (Just (Right revNo))) <- extraDeps ] + where parsePackageIdentifier :: String -> Maybe PackageIdentifier + parsePackageIdentifier = simpleParse + toText :: Text a => a -> T.Text + toText = fromString . show . disp + + +writeDoc :: FilePath -> Doc ann -> IO () +writeDoc file doc = + do handle <- openFile file WriteMode + hPutDoc handle doc + hClose handle + + +-- makeRelativeToCurrentDirectory +packages2nix :: Args -> Stack-> IO NExpr +packages2nix args (Stack _ _ pkgs) = + do cwd <- getCurrentDirectory + fmap (mkNonRecSet . concat) . forM pkgs $ \case + (LocalPath folder) -> + do cabalFiles <- findCabalFiles (dropFileName (argStackYaml args) folder) + forM cabalFiles $ \cabalFile -> + let pkg = cabalFilePkgName cabalFile + nix = pkg <.> "nix" + nixFile = argOutputDir args nix + src = Just . C2N.Path $ relPath ".." folder + in do createDirectoryIfMissing True (takeDirectory nixFile) + writeDoc nixFile =<< + prettyNix <$> cabal2nix src cabalFile + return $ fromString pkg $= mkPath False nix + (DVCS (Git url rev) subdirs) -> + fmap concat . forM subdirs $ \subdir -> + do cacheHits <- liftIO $ cacheHits (argCacheFile args) url rev subdir + case cacheHits of + [] -> do + fetch (\dir -> cabalFromPath url rev subdir $ dir subdir) + (Source url rev UnknownHash subdir) >>= \case + (Just (DerivationSource{..}, genBindings)) -> genBindings derivHash + _ -> return [] + hits -> + forM hits $ \( pkg, nix ) -> do + return $ fromString pkg $= mkPath False nix + _ -> return [] + where relPath = shortRelativePath (argOutputDir args) (dropFileName (argStackYaml args)) + cabalFromPath + :: String -- URL + -> String -- Revision + -> FilePath -- Subdir + -> FilePath -- Local Directory + -> MaybeT IO (String -> IO [Binding NExpr]) + cabalFromPath url rev subdir path = do + d <- liftIO $ doesDirectoryExist path + unless d $ fail ("not a directory: " ++ path) + cabalFiles <- liftIO $ findCabalFiles path + return $ \sha256 -> + forM cabalFiles $ \cabalFile -> do + let pkg = cabalFilePkgName cabalFile + nix = pkg <.> "nix" + nixFile = argOutputDir args nix + subdir' = if subdir == "." then Nothing + else Just subdir + src = Just $ C2N.Git url rev (Just sha256) subdir' + createDirectoryIfMissing True (takeDirectory nixFile) + writeDoc nixFile =<< + prettyNix <$> cabal2nix src cabalFile + liftIO $ appendCache (argCacheFile args) url rev subdir sha256 pkg nix + return $ fromString pkg $= mkPath False nix + +defaultNixContents :: String +defaultNixContents = unlines + [ "{ pkgs ? import {} }:" + , "" + , "let" + , " haskell = import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz) { inherit pkgs; };" + , "" + , " pkgSet = haskell.mkStackPkgSet {" + , " stack-pkgs = import ./pkgs.nix;" + , " pkg-def-overlays = [];" + , " modules = [];" + , " };" + , "" + , "in" + , " pkgSet.config.hsPkgs" + ] diff --git a/stack2nix/Stack2nix/CLI.hs b/stack2nix/Stack2nix/CLI.hs new file mode 100644 index 0000000..6c83a08 --- /dev/null +++ b/stack2nix/Stack2nix/CLI.hs @@ -0,0 +1,30 @@ +module Stack2nix.CLI + ( Args(..) + , parseStack2nixArgs + ) where + +import Options.Applicative hiding (option) +import Data.Semigroup ((<>)) + + +-------------------------------------------------------------------------------- +-- CLI Arguments +data Args = Args + { argOutputDir :: FilePath + , argStackYaml :: FilePath + , argCacheFile :: FilePath + } deriving Show + +-- Argument Parser +args :: Parser Args +args = Args + <$> strOption ( long "output" <> short 'o' <> metavar "DIR" <> help "Generate output in DIR" ) + <*> strOption ( long "stack-yaml" <> value "stack.yaml" <> showDefault <> metavar "FILE" <> help "Override project stack.yaml" ) + <*> strOption ( long "cache" <> value ".stack-to-nix.cache" <> showDefault <> metavar "FILE" <> help "Dependency cache file" ) + +parseStack2nixArgs :: IO Args +parseStack2nixArgs = execParser opts + where opts = info (args <**> helper) + ( fullDesc + <> progDesc "Generate a Nix expression for a Haskell package using Stack" + <> header "stack-to-nix - a stack to nix converter" ) diff --git a/stack2nix/Stack2nix/Cache.hs b/stack2nix/Stack2nix/Cache.hs new file mode 100644 index 0000000..3c38c43 --- /dev/null +++ b/stack2nix/Stack2nix/Cache.hs @@ -0,0 +1,35 @@ +module Stack2nix.Cache + ( readCache + , appendCache + , cacheHits + ) where + +import Control.Exception (catch, SomeException(..)) + +readCache :: FilePath + -> IO [( String -- url + , String -- rev + , String -- subdir + , String -- sha256 + , String -- pkgname + , String -- nixexpr-path + )] +readCache f = fmap (toTuple . words) . lines <$> readFile f + where toTuple [ url, rev, subdir, sha256, pkgname, exprPath ] + = ( url, rev, subdir, sha256, pkgname, exprPath ) + +appendCache :: FilePath -> String -> String -> String -> String -> String -> String -> IO () +appendCache f url rev subdir sha256 pkgname exprPath = do + appendFile f $ unwords [ url, rev, subdir, sha256, pkgname, exprPath ] + appendFile f "\n" + +cacheHits :: FilePath -> String -> String -> String -> IO [ (String, String) ] +cacheHits f url rev subdir + = do cache <- catch' (readCache f) (const (pure [])) + return [ ( pkgname, exprPath ) + | ( url', rev', subdir', sha256, pkgname, exprPath ) <- cache + , url == url' + , rev == rev' + , subdir == subdir' ] + where catch' :: IO a -> (SomeException -> IO a) -> IO a + catch' = catch diff --git a/stack2nix/Stack2nix/External/Resolve.hs b/stack2nix/Stack2nix/External/Resolve.hs new file mode 100644 index 0000000..4cf8e68 --- /dev/null +++ b/stack2nix/Stack2nix/External/Resolve.hs @@ -0,0 +1,47 @@ +module Stack2nix.External.Resolve + ( resolveSnapshot + ) where + +import Control.Monad (unless) +import Data.Aeson +import Data.Yaml hiding (Parser) +import Control.Applicative ((<|>)) +import Data.List (isPrefixOf, isSuffixOf) + +import qualified Data.ByteString.Lazy.Char8 as L8 + +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Network.HTTP.Types.Status (ok200) +import Control.Exception.Base (SomeException(..),PatternMatchFail(..)) + +import Stack2nix.Stack (Stack(..), StackSnapshot(..)) + +-- | A @resolver@ value in a stack.yaml file may point to an URL. As such +-- we need to be able to fetch one. +decodeURLEither :: FromJSON a => String -> IO (Either ParseException a) +decodeURLEither url + | not (("http://" `isPrefixOf` url) || ("https://" `isPrefixOf` url)) + = return . Left . OtherParseException . SomeException . PatternMatchFail $ "No http or https prefix" + | otherwise = do + manager <- newManager tlsManagerSettings + request <- parseRequest url + response <- httpLbs request manager + unless (ok200 == responseStatus response) $ error ("failed to download " ++ url) + return . decodeEither' . L8.toStrict $ responseBody response + + +-- | If a stack.yaml file contains a @resolver@ that points to +-- a file, resolve that file and merge the snapshot into the +-- @Stack@ record. +resolveSnapshot :: Stack -> IO Stack +resolveSnapshot stack@(Stack resolver compiler pkgs) + = if ".yaml" `isSuffixOf` resolver + then do evalue <- if ("http://" `isPrefixOf` resolver) || ("https://" `isPrefixOf` resolver) + then decodeURLEither resolver + else decodeFileEither resolver + case evalue of + Left e -> error (show e) + Right (Snapshot resolver' compiler' _name pkgs') -> + pure $ Stack resolver' (compiler' <|> compiler) (pkgs <> pkgs') + else pure stack diff --git a/stack2nix/Stack2nix/Project.hs b/stack2nix/Stack2nix/Project.hs new file mode 100644 index 0000000..be1f4a8 --- /dev/null +++ b/stack2nix/Stack2nix/Project.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE LambdaCase #-} + +module Stack2nix.Project + ( findCabalFiles + ) where + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.ByteString (ByteString) + +import System.FilePath (()) +import System.Directory (listDirectory, doesFileExist) +import Data.List (isSuffixOf) + +import qualified Hpack +import qualified Hpack.Config as Hpack +import qualified Hpack.Render as Hpack + +import Cabal2Nix (CabalFile(..), CabalFileGenerator(..)) + +findCabalFiles :: FilePath -> IO [CabalFile] +findCabalFiles path = doesFileExist (path Hpack.packageConfig) >>= \case + False -> fmap (OnDisk . (path )) . filter (isSuffixOf ".cabal") <$> listDirectory path + True -> do + mbPkg <- Hpack.readPackageConfig Hpack.defaultDecodeOptions {Hpack.decodeOptionsTarget = path Hpack.packageConfig} + case mbPkg of + Left e -> error e + Right r -> + return $ [InMemory (Just Hpack) + (Hpack.decodeResultCabalFile r) + (encodeUtf8 $ Hpack.renderPackage [] (Hpack.decodeResultPackage r))] + + where encodeUtf8 :: String -> ByteString + encodeUtf8 = T.encodeUtf8 . T.pack diff --git a/stack2nix/Stack2nix/Stack.hs b/stack2nix/Stack2nix/Stack.hs new file mode 100644 index 0000000..bdbdd1e --- /dev/null +++ b/stack2nix/Stack2nix/Stack.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Stack2nix.Stack + ( Resolver + , Name + , Compiler + , Sha256 + , CabalRev + , URL + , Rev + , Stack(..) + , Compiler(..) + , Dependency(..) + , Location(..) + , StackSnapshot(..) + ) where + +import Data.List (isSuffixOf) +import qualified Data.Text as T +import Data.Aeson +import Control.Applicative ((<|>)) + +import Distribution.Types.PackageName +import Distribution.Types.PackageId +import Distribution.Compat.ReadP hiding (Parser) +import Distribution.Text +import Distribution.Types.Version (nullVersion) + + +-------------------------------------------------------------------------------- +-- The stack.yaml file +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- packages +-- +-- * (1) Paths +-- - ./site1 +-- - ./site2 +-- * (2) Git Locations +-- - location: +-- git: https://github.com/yesodweb/yesod +-- commit: 7038ae6317cb3fe4853597633ba7a40804ca9a46 +-- extra-dep: true +-- subdirs: +-- - yesod-core +-- - yesod-bin + +-------------------------------------------------------------------------------- +-- extra-deps +-- +-- * (1) Package index (optional sha of cabal files contents; or revision number) +-- - acme-missiles-0.3 +-- - acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1 +-- - acme-missiles-0.3@rev:0 +-- +-- * (2) Local File Path (foo-1.2.3 would be parsed as a package index) +-- - vendor/somelib +-- - ./foo-1.2.3 +-- +-- * (3) Git and Mercurial repos (optional subdirs; or github) +-- - git: git@github.com:commercialhaskell/stack.git +-- commit: 6a86ee32e5b869a877151f74064572225e1a0398 +-- - git: git@github.com:snoyberg/http-client.git +-- commit: "a5f4f3" +-- - hg: https://example.com/hg/repo +-- commit: da39a3ee5e6b4b0d3255bfef95601890afd80709 +-- - git: git@github.com:yesodweb/wai +-- commit: 2f8a8e1b771829f4a8a77c0111352ce45a14c30f +-- subdirs: +-- - auto-update +-- - wai +-- - github: snoyberg/http-client +-- commit: a5f4f30f01366738f913968163d856366d7e0342 +-- +-- * (4) Archives (HTTP(S) or local filepath) +-- - https://example.com/foo/bar/baz-0.0.2.tar.gz +-- - archive: http://github.com/yesodweb/wai/archive/2f8a8e1b771829f4a8a77c0111352ce45a14c30f.zip +-- subdirs: +-- - wai +-- - warp +-- - archive: ../acme-missiles-0.3.tar.gz +-- sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b + +-- NOTE: We will only parse a suitable subset of the stack.yaml file. + +-------------------------------------------------------------------------------- +-- Some generic types +type Resolver = String +type Name = String +type Compiler = String +type Sha256 = String +type CabalRev = Int -- cabal revision 0,1,2,... +type URL = String -- Git/Hg/... URL +type Rev = String -- Git revision + +-------------------------------------------------------------------------------- +-- Data Types +-- Dependencies are the merged set of packages and extra-deps. +-- As we do not distinguish them in the same way stack does, we +-- can get away with this. +data Dependency + = PkgIndex PackageIdentifier (Maybe (Either Sha256 CabalRev)) -- ^ overridden package in the stackage index + | LocalPath String -- ^ Some local package (potentially overriding a package in the index as well) + | DVCS Location [FilePath] -- ^ One or more packages fetched from git or similar. + -- TODO: Support archives. + -- | Archive ... + deriving (Show) + +data Stack + = Stack Resolver (Maybe Compiler) [Dependency] + deriving (Show) + +-- stack supports custom snapshots +-- https://docs.haskellstack.org/en/stable/custom_snapshot/ +data StackSnapshot + = Snapshot + Resolver -- lts-XX.YY/nightly-... + (Maybe Compiler) -- possible compiler override for the snapshot + Name -- name + [Dependency] -- packages + -- [Package -> [Flag]] -- flags + -- [PackageName] -- drop-packages + -- [PackageName -> Bool] -- hidden + -- [package -> [Opt]] -- ghc-options + deriving (Show) + +data Location + = Git URL Rev + | HG URL Rev + deriving (Show) + +-------------------------------------------------------------------------------- +-- Parsers for package indices +sha256Suffix :: ReadP r Sha256 +sha256Suffix = string "@sha256:" *> many1 (satisfy (`elem` (['0'..'9']++['a'..'z']++['A'..'Z']))) + +revSuffix :: ReadP r CabalRev +revSuffix = string "@rev:" *> (read <$> many1 (satisfy (`elem` ['0'..'9']))) + +suffix :: ReadP r (Maybe (Either Sha256 CabalRev)) +suffix = option Nothing (Just <$> (Left <$> sha256Suffix) +++ (Right <$> revSuffix)) + +pkgIndex :: ReadP r Dependency +pkgIndex = PkgIndex <$> parse <*> suffix <* eof + +-------------------------------------------------------------------------------- +-- JSON/YAML destructors + +instance FromJSON Location where + parseJSON = withObject "Location" $ \l -> Git + <$> l .: "git" + <*> l .: "commit" + +instance FromJSON Stack where + parseJSON = withObject "Stack" $ \s -> Stack + <$> s .: "resolver" + <*> s .:? "compiler" .!= Nothing + <*> ((<>) <$> s .:? "packages" .!= [] + <*> s .:? "extra-deps" .!= []) + +instance FromJSON StackSnapshot where + parseJSON = withObject "Snapshot" $ \s -> Snapshot + <$> s .: "resolver" + <*> s .:? "compiler" .!= Nothing + <*> s .: "name" + <*> s .:? "packages" .!= [] + +instance FromJSON Dependency where + -- Note: we will parse foo-X.Y.Z as a package. + -- if we want it to be a localPath, it needs + -- to be ./foo-X.Y.Z + parseJSON p = parsePkgIndex p <|> parseLocalPath p <|> parseDVCS p + where parsePkgIndex = withText "Package Index" $ \pi -> + case [pi' | (pi',"") <- readP_to_S pkgIndex (T.unpack pi)] of + -- Cabal will happily parse "foo" as a packageIdentifier, + -- we however are only interested in those that have a version + -- as well. Any valid version is larger than @nullVersion@, as + -- such we can use that as a filter. + [pi'@(PkgIndex pkgIdent _)] | pkgVersion pkgIdent > nullVersion -> return $ pi' + _ -> fail $ "invalid package index: " ++ show pi + parseLocalPath = withText "Local Path" $ + return . LocalPath . dropTrailingSlash . T.unpack + parseDVCS = withObject "DVCS" $ \o -> DVCS + <$> (o .: "location" <|> parseJSON p) + <*> o .:? "subdirs" .!= ["."] + + -- drop trailing slashes. Nix doesn't like them much; + -- stack doesn't seem to care. + dropTrailingSlash p | "/" `isSuffixOf` p = take (length p - 1) p + dropTrailingSlash p = p