{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE TypeFamilies       #-}

-- this is in a separate module because the TypeFamilies extension apparently
-- causes previously valid code to not typecheck... ok
module Development.Shake.Cabal.Oracles ( hsOracle
                                       , cabalOracle
                                       , CabalOracle
                                       , HsCompiler (..)
                                       , CabalVersion (..)
                                       ) where

import           Control.DeepSeq   (NFData)
import           Data.Binary       (Binary)
import           Data.Hashable     (Hashable)
import           Data.Typeable     (Typeable)
import           Development.Shake
import           GHC.Generics      (Generic)

type CabalOracle = CabalVersion -> Action String

-- | Use this for tracking 'HsCompiler'
--
-- @since 0.2.1.0
hsOracle :: (RuleResult q ~ a, q ~ a, ShakeValue q) => Rules (q -> Action a)
hsOracle :: forall q a.
(RuleResult q ~ a, q ~ a, ShakeValue q) =>
Rules (q -> Action a)
hsOracle = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Use this to track the version of cabal globally available
--
-- @since 0.2.1.0
cabalOracle :: Rules CabalOracle
cabalOracle :: Rules CabalOracle
cabalOracle = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle forall a b. (a -> b) -> a -> b
$ \CabalVersion
CabalVersion -> do
    (Stdout String
out) <- forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [] String
"cabal" [ String
"--numeric-version"]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure String
out

data HsCompiler = GHC { HsCompiler -> Maybe String
_pref :: Maybe String -- ^ Target architecture
                      , HsCompiler -> Maybe String
_suff :: Maybe String -- ^ Compiler version
                      }
                | GHCJS { _suff :: Maybe String -- ^ Compiler version
                        }
                deriving (forall x. Rep HsCompiler x -> HsCompiler
forall x. HsCompiler -> Rep HsCompiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HsCompiler x -> HsCompiler
$cfrom :: forall x. HsCompiler -> Rep HsCompiler x
Generic, Int -> HsCompiler -> ShowS
[HsCompiler] -> ShowS
HsCompiler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsCompiler] -> ShowS
$cshowList :: [HsCompiler] -> ShowS
show :: HsCompiler -> String
$cshow :: HsCompiler -> String
showsPrec :: Int -> HsCompiler -> ShowS
$cshowsPrec :: Int -> HsCompiler -> ShowS
Show, HsCompiler -> HsCompiler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsCompiler -> HsCompiler -> Bool
$c/= :: HsCompiler -> HsCompiler -> Bool
== :: HsCompiler -> HsCompiler -> Bool
$c== :: HsCompiler -> HsCompiler -> Bool
Eq, HsCompiler -> ()
forall a. (a -> ()) -> NFData a
rnf :: HsCompiler -> ()
$crnf :: HsCompiler -> ()
NFData, Eq HsCompiler
Int -> HsCompiler -> Int
HsCompiler -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HsCompiler -> Int
$chash :: HsCompiler -> Int
hashWithSalt :: Int -> HsCompiler -> Int
$chashWithSalt :: Int -> HsCompiler -> Int
Hashable, Get HsCompiler
[HsCompiler] -> Put
HsCompiler -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [HsCompiler] -> Put
$cputList :: [HsCompiler] -> Put
get :: Get HsCompiler
$cget :: Get HsCompiler
put :: HsCompiler -> Put
$cput :: HsCompiler -> Put
Binary, Typeable)

data CabalVersion = CabalVersion
    deriving (forall x. Rep CabalVersion x -> CabalVersion
forall x. CabalVersion -> Rep CabalVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalVersion x -> CabalVersion
$cfrom :: forall x. CabalVersion -> Rep CabalVersion x
Generic, Int -> CabalVersion -> ShowS
[CabalVersion] -> ShowS
CabalVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalVersion] -> ShowS
$cshowList :: [CabalVersion] -> ShowS
show :: CabalVersion -> String
$cshow :: CabalVersion -> String
showsPrec :: Int -> CabalVersion -> ShowS
$cshowsPrec :: Int -> CabalVersion -> ShowS
Show, Typeable, CabalVersion -> CabalVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalVersion -> CabalVersion -> Bool
$c/= :: CabalVersion -> CabalVersion -> Bool
== :: CabalVersion -> CabalVersion -> Bool
$c== :: CabalVersion -> CabalVersion -> Bool
Eq, Eq CabalVersion
Int -> CabalVersion -> Int
CabalVersion -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: CabalVersion -> Int
$chash :: CabalVersion -> Int
hashWithSalt :: Int -> CabalVersion -> Int
$chashWithSalt :: Int -> CabalVersion -> Int
Hashable, Get CabalVersion
[CabalVersion] -> Put
CabalVersion -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CabalVersion] -> Put
$cputList :: [CabalVersion] -> Put
get :: Get CabalVersion
$cget :: Get CabalVersion
put :: CabalVersion -> Put
$cput :: CabalVersion -> Put
Binary, CabalVersion -> ()
forall a. (a -> ()) -> NFData a
rnf :: CabalVersion -> ()
$crnf :: CabalVersion -> ()
NFData)

type instance RuleResult HsCompiler = HsCompiler
type instance RuleResult CabalVersion = String