@@ -0,0 +1,96 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE NoImplicitPrelude #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE RankNTypes #-}
6+{-# LANGUAGE ViewPatterns #-}
7+-- | Dealing with the 00-index file and all its cabal files.
8+module Stackage2.PackageIndex
9+ ( sourcePackageIndex
10+ ) where
11+
12+import qualified Codec.Archive.Tar as Tar
13+import qualified Codec.Archive.Tar.Entry as TarEntry
14+import Data.Conduit.Lazy (MonadActive,
15+ lazyConsume)
16+import qualified Data.Text as T
17+import Distribution.PackageDescription (GenericPackageDescription)
18+import Distribution.PackageDescription.Parse (ParseResult (..),
19+ parsePackageDescription)
20+import Distribution.ParseUtils (PError)
21+import Stackage2.Prelude
22+import System.Directory (getAppUserDataDirectory)
23+
24+-- | Name of the 00-index.tar downloaded from Hackage.
25+getPackageIndexPath :: MonadIO m => m FilePath
26+getPackageIndexPath = liftIO $ do
27+ c <- getCabalRoot
28+ configLines <- runResourceT $ sourceFile (c </> "config")
29+ $$ decodeUtf8C
30+ =$ linesUnboundedC
31+ =$ concatMapC getRemoteCache
32+ =$ sinkList
33+ case configLines of
34+ [x] -> return $ x </> "hackage.haskell.org" </> "00-index.tar"
35+ [] -> error $ "No remote-repo-cache found in Cabal config file"
36+ _ -> error $ "Multiple remote-repo-cache entries found in Cabal config file"
37+ where
38+ getCabalRoot :: IO FilePath
39+ getCabalRoot = fpFromString <$> getAppUserDataDirectory "cabal"
40+
41+ getRemoteCache s = do
42+ ("remote-repo-cache", stripPrefix ":" -> Just v) <- Just $ break (== ':') s
43+ Just $ fpFromText $ T.strip v
44+
45+data UnparsedCabalFile = UnparsedCabalFile
46+ { ucfName :: PackageName
47+ , ucfVersion :: Version
48+ , ucfParse :: forall m. MonadThrow m => m GenericPackageDescription
49+ }
50+
51+sourcePackageIndex :: (MonadThrow m, MonadResource m, MonadActive m, MonadBaseControl IO m)
52+ => Producer m UnparsedCabalFile
53+sourcePackageIndex = do
54+ fp <- getPackageIndexPath
55+ -- yay for the tar package. Use lazyConsume instead of readFile to get some
56+ -- kind of resource protection
57+ lbs <- lift $ fromChunks <$> lazyConsume (sourceFile fp)
58+ loop (Tar.read lbs)
59+ where
60+ loop (Tar.Next e es) = goE e >> loop es
61+ loop Tar.Done = return ()
62+ loop (Tar.Fail e) = throwM e
63+
64+ goE e
65+ | Just front <- stripSuffix ".cabal" $ pack $ Tar.entryPath e
66+ , Tar.NormalFile lbs _size <- Tar.entryContent e = do
67+ (name, version) <- parseNameVersion front
68+ yield UnparsedCabalFile
69+ { ucfName = name
70+ , ucfVersion = version
71+ , ucfParse = goContent (Tar.entryPath e) lbs
72+ }
73+ | otherwise = return ()
74+
75+ goContent fp lbs =
76+ case parsePackageDescription $ unpack $ decodeUtf8 lbs of
77+ ParseFailed e -> throwM $ CabalParseException (fpFromString fp) e
78+ ParseOk _warnings gpd -> return gpd
79+
80+ parseNameVersion t1 = do
81+ let (p', t2) = break (== '/') t1
82+ p <- simpleParse p'
83+ t3 <- maybe (throwM $ InvalidCabalPath t1 "no slash") return
84+ $ stripPrefix "/" t2
85+ let (v', t4) = break (== '/') t3
86+ v <- simpleParse v'
87+ when (t4 /= cons '/' p') $ throwM $ InvalidCabalPath t1 $ "Expected at end: " ++ p'
88+ return (p, v)
89+
90+data InvalidCabalPath = InvalidCabalPath Text Text
91+ deriving (Show, Typeable)
92+instance Exception InvalidCabalPath
93+
94+data CabalParseException = CabalParseException FilePath PError
95+ deriving (Show, Typeable)
96+instance Exception CabalParseException