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

module Oracles.PackageData (
4
5
6
    PackageData (..), PackageDataMulti (..),
    PackageDataKey (..),
    pkgData, pkgDataMulti
7
8
9
    ) where

import Util
10
import Data.List
11
import Data.Maybe
12
13
14
import Development.Shake
import Development.Shake.Classes
import Development.Shake.FilePath
15

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

25
data PackageData = Version     FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
26
                 | PackageKey  FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
27
                 | Synopsis    FilePath
28

29
data PackageDataMulti = Modules        FilePath
30
31
32
33
34
35
36
37
38
39
                      | SrcDirs        FilePath
                      | IncludeDirs    FilePath
                      | Deps           FilePath
                      | DepKeys        FilePath
                      | DepNames       FilePath
                      | CppArgs        FilePath
                      | HsArgs         FilePath
                      | CcArgs         FilePath
                      | CSrcs          FilePath
                      | DepIncludeDirs FilePath
40
41
42
43

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

44
45
46
47
48
49
50
51
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

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

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
pkgDataMulti :: PackageDataMulti -> Action [String]
pkgDataMulti packageData = do
    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
        pkgData = path </> "package-data.mk"
        unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
    res <- askOracle $ PackageDataKey (pkgData, fullKey)
    return $ map unquote $ words $ case res of
        Nothing    -> error $ "No key '" ++ key ++ "' in "
                            ++ unifyPath pkgData ++ "."
        Just ""    -> defaultValue
        Just value -> value