{-# LANGUAGE RecordWildCards #-}

module Development.IDE.Graph.Internal.Options where

import qualified Development.Shake as Shake
import qualified Data.HashMap.Strict as Map
import Development.IDE.Graph.Internal.Action
import Development.IDE.Graph.Internal.Rules
import Data.Dynamic

data ShakeOptions = ShakeOptions {
    ShakeOptions -> Int
shakeThreads :: Int,
    ShakeOptions -> FilePath
shakeFiles :: FilePath,
    ShakeOptions -> Maybe Dynamic
shakeExtra :: Maybe Dynamic,
    ShakeOptions -> Bool
shakeAllowRedefineRules :: Bool,
    ShakeOptions -> Bool
shakeTimings :: Bool
    }

shakeOptions :: ShakeOptions
shakeOptions :: ShakeOptions
shakeOptions = Int -> FilePath -> Maybe Dynamic -> Bool -> Bool -> ShakeOptions
ShakeOptions Int
0 FilePath
".shake" Maybe Dynamic
forall a. Maybe a
Nothing Bool
False Bool
False

fromShakeOptions :: ShakeOptions -> Shake.ShakeOptions
fromShakeOptions :: ShakeOptions -> ShakeOptions
fromShakeOptions ShakeOptions{Bool
Int
FilePath
Maybe Dynamic
shakeTimings :: Bool
shakeAllowRedefineRules :: Bool
shakeExtra :: Maybe Dynamic
shakeFiles :: FilePath
shakeThreads :: Int
shakeTimings :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeExtra :: ShakeOptions -> Maybe Dynamic
shakeFiles :: ShakeOptions -> FilePath
shakeThreads :: ShakeOptions -> Int
..} = ShakeOptions
Shake.shakeOptions{
    shakeThreads :: Int
Shake.shakeThreads = Int
shakeThreads,
    shakeFiles :: FilePath
Shake.shakeFiles = FilePath
shakeFiles,
    shakeExtra :: HashMap TypeRep Dynamic
Shake.shakeExtra = HashMap TypeRep Dynamic
-> (Dynamic -> HashMap TypeRep Dynamic)
-> Maybe Dynamic
-> HashMap TypeRep Dynamic
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap TypeRep Dynamic
forall k v. HashMap k v
Map.empty Dynamic -> HashMap TypeRep Dynamic
f Maybe Dynamic
shakeExtra,
    shakeAllowRedefineRules :: Bool
Shake.shakeAllowRedefineRules = Bool
shakeAllowRedefineRules,
    shakeTimings :: Bool
Shake.shakeTimings = Bool
shakeTimings
    }
    where f :: Dynamic -> HashMap TypeRep Dynamic
f Dynamic
x = TypeRep -> Dynamic -> HashMap TypeRep Dynamic
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton (Dynamic -> TypeRep
dynTypeRep Dynamic
x) Dynamic
x


getShakeExtra :: Typeable a => Action (Maybe a)
getShakeExtra :: Action (Maybe a)
getShakeExtra = Action (Maybe a) -> Action (Maybe a)
forall a. Action a -> Action a
Action Action (Maybe a)
forall a. Typeable a => Action (Maybe a)
Shake.getShakeExtra

getShakeExtraRules :: Typeable a => Rules (Maybe a)
getShakeExtraRules :: Rules (Maybe a)
getShakeExtraRules = Rules (Maybe a) -> Rules (Maybe a)
forall a. Rules a -> Rules a
Rules Rules (Maybe a)
forall a. Typeable a => Rules (Maybe a)
Shake.getShakeExtraRules

newShakeExtra :: Typeable a => a -> Maybe Dynamic
newShakeExtra :: a -> Maybe Dynamic
newShakeExtra = Dynamic -> Maybe Dynamic
forall a. a -> Maybe a
Just (Dynamic -> Maybe Dynamic) -> (a -> Dynamic) -> a -> Maybe Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn