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

module Oracles.PackageData (
4
    PackageData (..), MultiPackageData (..),
5
    PackageDataKey (..), askPackageData
6
7
8
9
10
    ) where

import Development.Shake.Classes
import Base
import Util
11
import Data.List
12
import Data.Maybe
13

14
15
16
17
18
19
20
21
-- For each (PackageData path) the file 'path/package-data.mk' contains
-- a line of the form 'path_VERSION = 1.2.3.4'.
-- (showArg $ PackageData path) is an action that consults the file and
-- returns "1.2.3.4".
--
-- MultiPackageData is used for multiple string options separated by spaces,
-- such as 'path_MODULES = Data.Array Data.Array.Base ...'.
-- (showArgs Modules) therefore returns ["Data.Array", "Data.Array.Base", ...].
22

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 MultiPackageData = Modules        FilePath
                      | SrcDirs        FilePath
                      | IncludeDirs    FilePath
                      | Deps           FilePath
                      | DepKeys        FilePath
                      | DepNames       FilePath
                      | CppArgs        FilePath
                      | HsArgs         FilePath
                      | CcArgs         FilePath
                      | CSrcs          FilePath
                      | DepIncludeDirs FilePath
38
39
40
41

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

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

-- TODO: remove
51
52
53
54
55
56
57
58
59
60
instance ShowArg PackageData where
    showArg 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
            pkgData = path </> "package-data.mk"
        res <- askOracle $ PackageDataKey (pkgData, fullKey)
        return $ fromMaybe
61
            (error $ "No key '" ++ key ++ "' in " ++ unifyPath pkgData ++ ".")
62
63
64
            res

instance ShowArgs MultiPackageData where
Andrey Mokhov's avatar
Andrey Mokhov committed
65
    showArgs packageData = do
66
        let (key, path, defaultValue) = case packageData of
67
68
69
70
71
72
73
74
75
76
               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, "" )
77
78
               DepIncludeDirs path -> ("DEP_INCLUDE_DIRS_SINGLE_QUOTED"
                                      , path, "")
79
80
            fullKey = replaceSeparators '_' $ path ++ "_" ++ key
            pkgData = path </> "package-data.mk"
81
            unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
Andrey Mokhov's avatar
Andrey Mokhov committed
82
        res <- askOracle $ PackageDataKey (pkgData, fullKey)
83
        return $ map unquote $ words $ case res of
Andrey Mokhov's avatar
Andrey Mokhov committed
84
            Nothing    -> error $ "No key '" ++ key ++ "' in "
85
                                ++ unifyPath pkgData ++ "."
Andrey Mokhov's avatar
Andrey Mokhov committed
86
            Just ""    -> defaultValue
Andrey Mokhov's avatar
Andrey Mokhov committed
87
            Just value -> value