git.iko.soy/typeable/cabal2nix
on c9511fd help sign in
typeable/cabal2nix/hackage2nix/src/Stackage.hs
106 lines 3.6 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE StandaloneDeriving #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Stackage where
7import Control.DeepSeq.Generics
8import Control.Monad
9import Control.Monad.Par.Combinator
10import Control.Monad.Par.IO
11import Control.Monad.Trans
12import Data.List
13import Data.List.Split
14import Data.Map as Map
15import Data.Maybe
16import Data.Time.Calendar
17import Data.Yaml
18import Distribution.Compiler
19import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
20import Distribution.Package
21import Distribution.PackageDescription
22import Distribution.Version
23import GHC.Generics ( Generic )
24import Stackage.Types hiding ( display )
25import System.Directory
26import System.FilePath
27import Text.PrettyPrint.HughesPJClass
29data Spec = Spec
30 { version :: Version
31 , flagOverrides :: Map FlagName Bool
32 , runTests :: Bool
33 , runHaddock :: Bool
34 , runLinuxBuilds :: Bool
35 }
36 deriving (Show, Generic)
38instance Eq Spec where
39 a == b = version a == version b
41instance Ord Spec where
42 compare a b = compare (version a) (version b)
44data Snapshot = Snapshot
45 { snapshot :: SnapshotType
46 , compiler :: CompilerId
47 , corePackages :: Map PackageName Version
48 , packages :: Map PackageName Spec
49 }
50 deriving (Show, Generic)
52deriving instance Generic SnapshotType
53instance NFData Spec where
54instance NFData Snapshot where
55instance NFData SnapshotType where
57instance Pretty SnapshotType where
58 pPrint STNightly = text "stackage-nightly"
59 pPrint (STNightly2 _) = text "stackage-nightly"
60 pPrint (STLTS m n) = text "lts-" <> int m <> char '.' <> int n
62readLTSHaskell :: FilePath -> ParIO [Snapshot]
63readLTSHaskell dirPath = do
64 filePaths <- liftIO (listFiles dirPath)
65 parMapM (liftIO . readSnapshot) [ dirPath </> p | p <- filePaths, takeExtension p == ".yaml" ]
67readStackageNightly :: FilePath -> IO Snapshot
68readStackageNightly dirPath = do
69 filePaths <- liftIO (listFiles dirPath)
70 let filePath = maximum [ p | p <- filePaths, takeExtension p == ".yaml" ]
71 readSnapshot (dirPath </> filePath)
73readSnapshot :: FilePath -> IO Snapshot
74readSnapshot p = fmap (fromBuildPlan (parseSnapshotType (takeFileName p))) (readBuildPlan p)
76parseSnapshotType :: FilePath -> SnapshotType
77parseSnapshotType p
78 | "lts-" `isPrefixOf` p
79 , [major,minor] <- splitOn "." (drop 4 (dropExtension p))
80 = STLTS (read major) (read minor)
81 | "nightly-" `isPrefixOf` p
82 , [year,month,day] <- splitOn "-" (drop 8 (dropExtension p))
83 = STNightly2 (fromGregorian (read year) (read month) (read day))
84 | otherwise = error ("parseSnapshotType: invalid file name " ++ p)
86readBuildPlan :: FilePath -> IO BuildPlan
87readBuildPlan = fmap fromJust . decodeFile
89fromBuildPlan :: SnapshotType -> BuildPlan -> Snapshot
90fromBuildPlan snt bp = Snapshot snt
91 (CompilerId GHC (siGhcVersion (bpSystemInfo bp)))
92 (siCorePackages (bpSystemInfo bp))
93 (Map.map fromPackagePlan (bpPackages bp))
95fromPackagePlan :: PackagePlan -> Spec
96fromPackagePlan pp = Spec (ppVersion pp)
97 (pcFlagOverrides ppc)
98 (pcTests ppc == ExpectSuccess)
99 (pcHaddocks ppc == ExpectSuccess)
100 (not (pcSkipBuild ppc))
101 where ppc = ppConstraints pp
103listFiles :: FilePath -> IO [FilePath]
104listFiles path = do
105 let isFile p = doesFileExist (path </> p)
106 getDirectoryContents path >>= filterM isFile . Prelude.filter (\x -> head x /= '.')