PackageData.hs 4.1 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2
3

module Oracles.PackageData (
4
5
    PackageData (..), PackageDataList (..),
    pkgData, pkgDataList, packageDataOracle
6
7
8
    ) where

import Util
9
import Oracles.Base
10
import Data.List
11
import Data.Maybe
12
13
import Control.Applicative
import qualified Data.HashMap.Strict as Map
14

15
16
-- For each (PackageData path) the file 'path/package-data.mk' contains
-- a line of the form 'path_VERSION = 1.2.3.4'.
17
-- pkgData $ PackageData path is an action that consults the file and
18
19
-- returns "1.2.3.4".
--
20
-- PackageDataList is used for multiple string options separated by spaces,
21
-- such as 'path_MODULES = Data.Array Data.Array.Base ...'.
22
-- pkgListData Modules therefore returns ["Data.Array", "Data.Array.Base", ...]
23
data PackageData = Version     FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
24
                 | PackageKey  FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
25
                 | Synopsis    FilePath
26

27
28
29
30
31
32
33
34
35
36
37
data PackageDataList = Modules        FilePath
                     | SrcDirs        FilePath
                     | IncludeDirs    FilePath
                     | Deps           FilePath
                     | DepKeys        FilePath
                     | DepNames       FilePath
                     | CppArgs        FilePath
                     | HsArgs         FilePath
                     | CcArgs         FilePath
                     | CSrcs          FilePath
                     | DepIncludeDirs FilePath
38
39

newtype PackageDataKey = PackageDataKey (FilePath, String)
40
    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
41

42
-- TODO: is this needed?
43
44
45
askPackageData :: FilePath -> String -> Action String
askPackageData path key = do
    let fullKey = replaceSeparators '_' $ path ++ "_" ++ key
46
        pkgData = path -/- "package-data.mk"
47
48
49
50
    value <- askOracle $ PackageDataKey (pkgData, fullKey)
    return $ fromMaybe
        (error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") value

51
52
53
54
55
56
57
pkgData :: PackageData -> Action String
pkgData packageData = do
    let (key, path) = case packageData of
           Version     path -> ("VERSION"     , path)
           PackageKey  path -> ("PACKAGE_KEY" , path)
           Synopsis    path -> ("SYNOPSIS"    , path)
        fullKey = replaceSeparators '_' $ path ++ "_" ++ key
58
        pkgData = path -/- "package-data.mk"
59
60
    res <- askOracle $ PackageDataKey (pkgData, fullKey)
    return $ fromMaybe
61
        (error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") res
62

63
64
pkgDataList :: PackageDataList -> Action [String]
pkgDataList packageData = do
65
66
67
68
69
70
71
72
73
74
75
76
77
    let (key, path, defaultValue) = case packageData of
           Modules        path -> ("MODULES"                       , path, "" )
           SrcDirs        path -> ("HS_SRC_DIRS"                   , path, ".")
           IncludeDirs    path -> ("INCLUDE_DIRS"                  , path, ".")
           Deps           path -> ("DEPS"                          , path, "" )
           DepKeys        path -> ("DEP_KEYS"                      , path, "" )
           DepNames       path -> ("DEP_NAMES"                     , path, "" )
           CppArgs        path -> ("CPP_OPTS"                      , path, "" )
           HsArgs         path -> ("HC_OPTS"                       , path, "" )
           CcArgs         path -> ("CC_OPTS"                       , path, "" )
           CSrcs          path -> ("C_SRCS"                        , path, "" )
           DepIncludeDirs path -> ("DEP_INCLUDE_DIRS_SINGLE_QUOTED", path, "" )
        fullKey = replaceSeparators '_' $ path ++ "_" ++ key
78
        pkgData = path -/- "package-data.mk"
79
80
81
        unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
    res <- askOracle $ PackageDataKey (pkgData, fullKey)
    return $ map unquote $ words $ case res of
82
        Nothing    -> error $ "No key '" ++ key ++ "' in " ++ pkgData ++ "."
83
84
        Just ""    -> defaultValue
        Just value -> value
85
86
87
88
89
90
91
92

-- Oracle for 'package-data.mk' files
packageDataOracle :: Rules ()
packageDataOracle = do
    pkgData <- newCache $ \file -> do
        need [file]
        putOracle $ "Reading " ++ file ++ "..."
        liftIO $ readConfigFile file
Andrey Mokhov's avatar
Andrey Mokhov committed
93
    addOracle $ \(PackageDataKey (file, key)) ->
94
95
        Map.lookup key <$> pkgData (unifyPath file)
    return ()