Base.hs 1.98 KB
Newer Older
1
{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}
Andrey Mokhov's avatar
Andrey Mokhov committed
2

3 4 5 6
module Base (
    module Development.Shake,
    module Development.Shake.FilePath,
    module Control.Applicative,
7
    module Data.Function,
8
    module Data.Monoid,
9
    module Data.List,
10
    Stage (..),
11
    Arg, ArgList,
12
    ShowArg (..), ShowArgs (..),
13
    productArgs, concatArgs
14 15
    ) where

16
import Development.Shake hiding ((*>))
17
import Development.Shake.FilePath
18
import Control.Applicative
19
import Data.Function
20 21
import Data.Monoid
import Data.List
22 23
import GHC.Generics
import Development.Shake.Classes
24

25
data Stage = Stage0 | Stage1 | Stage2 | Stage3 deriving (Eq, Enum, Generic)
26

Andrey Mokhov's avatar
Andrey Mokhov committed
27 28 29
instance Show Stage where
    show = show . fromEnum

30
-- The returned string or list of strings is a part of an argument list
Andrey Mokhov's avatar
Andrey Mokhov committed
31
-- to be passed to a Builder
32 33
type Arg     = Action String
type ArgList = Action [String]
34 35 36 37 38

instance Monoid a => Monoid (Action a) where
    mempty = return mempty
    mappend p q = mappend <$> p <*> q

39
class ShowArg a where
40 41 42 43 44 45 46
    showArg :: a -> Arg

instance ShowArg String where
    showArg = return

instance ShowArg a => ShowArg (Action a) where
    showArg = (showArg =<<)
47

Andrey Mokhov's avatar
Andrey Mokhov committed
48
class ShowArgs a where
49
    showArgs :: a -> ArgList
Andrey Mokhov's avatar
Andrey Mokhov committed
50

51 52
instance ShowArgs [String] where
    showArgs = return
Andrey Mokhov's avatar
Andrey Mokhov committed
53

Andrey Mokhov's avatar
Andrey Mokhov committed
54 55
instance ShowArgs a => ShowArgs (Action a) where
    showArgs = (showArgs =<<)
56

57
-- Generate a cross product collection of two argument collections
58
-- Example: productArgs ["-a", "-b"] "c" = args ["-a", "c", "-b", "c"]
59
productArgs :: (ShowArgs a, ShowArgs b) => a -> b -> ArgList
60 61 62 63 64 65
productArgs as bs = do
    as' <- showArgs as
    bs' <- showArgs bs
    return $ concat $ sequence [as', bs']

-- Similar to productArgs but concat resulting arguments pairwise
66
-- Example: concatArgs ["-a", "-b"] "c" = args ["-ac", "-bc"]
67
concatArgs :: (ShowArgs a, ShowArgs b) => a -> b -> ArgList
68 69 70 71
concatArgs as bs = do
    as' <- showArgs as
    bs' <- showArgs bs
    return $ map concat $ sequence [as', bs']
72 73 74 75

-- Instances for storing in the Shake database
instance Binary Stage
instance Hashable Stage