git.iko.soy/typeable/cabal2nix
on b42bd9e help sign in
typeable/cabal2nix/hackage2nix/src/Stackage.hs
114 lines 4.0 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE StandaloneDeriving #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Stackage where
7import Control.DeepSeq.Generics
8import Control.Exception ( assert )
9import Control.Monad
10import Control.Monad.Par.Combinator
11import Control.Monad.Par.IO
12import Control.Monad.Trans
13import Data.List
14import Data.List.Split
15import Data.Map as Map
16import Data.Maybe
17import Data.Time.Calendar
18import Data.Yaml
19import Distribution.Compiler
20import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
21import Distribution.Package
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 /= '.')
108mergeSpecs :: Spec -> Spec -> Spec
109mergeSpecs a b = Spec { version = assert (version a == version b) version a
110 -- , flagOverrides = flagOverrides a
111 , runTests = runTests a && runTests b
112 , runHaddock = runHaddock a && runHaddock b
113 -- , runLinuxBuilds = runLinuxBuilds a
114 }