{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}
module Experiments.Types (module Experiments.Types ) where

import           Control.DeepSeq
import           Data.Aeson
import           Data.Binary     (Binary)
import           Data.Hashable   (Hashable)
import           Data.Maybe      (fromMaybe)
import           Data.Version
import           GHC.Generics
import           Numeric.Natural

data CabalStack = Cabal | Stack
  deriving (CabalStack -> CabalStack -> Bool
(CabalStack -> CabalStack -> Bool)
-> (CabalStack -> CabalStack -> Bool) -> Eq CabalStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalStack -> CabalStack -> Bool
== :: CabalStack -> CabalStack -> Bool
$c/= :: CabalStack -> CabalStack -> Bool
/= :: CabalStack -> CabalStack -> Bool
Eq, Int -> CabalStack -> ShowS
[CabalStack] -> ShowS
CabalStack -> String
(Int -> CabalStack -> ShowS)
-> (CabalStack -> String)
-> ([CabalStack] -> ShowS)
-> Show CabalStack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalStack -> ShowS
showsPrec :: Int -> CabalStack -> ShowS
$cshow :: CabalStack -> String
show :: CabalStack -> String
$cshowList :: [CabalStack] -> ShowS
showList :: [CabalStack] -> ShowS
Show)

data Verbosity = Quiet | Normal | All
  deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbosity -> ShowS
showsPrec :: Int -> Verbosity -> ShowS
$cshow :: Verbosity -> String
show :: Verbosity -> String
$cshowList :: [Verbosity] -> ShowS
showList :: [Verbosity] -> ShowS
Show)
data Config = Config
  { Config -> Verbosity
verbosity         :: !Verbosity,
    -- For some reason, the Shake profile files are truncated and won't load
    Config -> Maybe String
shakeProfiling    :: !(Maybe FilePath),
    Config -> Maybe String
otMemoryProfiling :: !(Maybe FilePath),
    Config -> String
outputCSV         :: !FilePath,
    Config -> CabalStack
buildTool         :: !CabalStack,
    Config -> [String]
ghcideOptions     :: ![String],
    Config -> [String]
matches           :: ![String],
    Config -> Maybe Natural
repetitions       :: Maybe Natural,
    Config -> String
ghcide            :: FilePath,
    Config -> Int
timeoutLsp        :: Int,
    Config -> Example
example           :: Example,
    Config -> Bool
lspConfig         :: Bool
  }
  deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

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

data Example = Example
    { Example -> String
exampleName      :: !String
    , Example -> ExampleDetails
exampleDetails   :: ExampleDetails
    , Example -> [String]
exampleModules   :: [FilePath]
    , Example -> [String]
exampleExtraArgs :: [String]}
  deriving (Example -> Example -> Bool
(Example -> Example -> Bool)
-> (Example -> Example -> Bool) -> Eq Example
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Example -> Example -> Bool
== :: Example -> Example -> Bool
$c/= :: Example -> Example -> Bool
/= :: Example -> Example -> Bool
Eq, (forall x. Example -> Rep Example x)
-> (forall x. Rep Example x -> Example) -> Generic Example
forall x. Rep Example x -> Example
forall x. Example -> Rep Example x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Example -> Rep Example x
from :: forall x. Example -> Rep Example x
$cto :: forall x. Rep Example x -> Example
to :: forall x. Rep Example x -> Example
Generic, Int -> Example -> ShowS
[Example] -> ShowS
Example -> String
(Int -> Example -> ShowS)
-> (Example -> String) -> ([Example] -> ShowS) -> Show Example
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Example -> ShowS
showsPrec :: Int -> Example -> ShowS
$cshow :: Example -> String
show :: Example -> String
$cshowList :: [Example] -> ShowS
showList :: [Example] -> ShowS
Show)
  deriving anyclass (Get Example
[Example] -> Put
Example -> Put
(Example -> Put)
-> Get Example -> ([Example] -> Put) -> Binary Example
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Example -> Put
put :: Example -> Put
$cget :: Get Example
get :: Get Example
$cputList :: [Example] -> Put
putList :: [Example] -> Put
Binary, Eq Example
Eq Example =>
(Int -> Example -> Int) -> (Example -> Int) -> Hashable Example
Int -> Example -> Int
Example -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Example -> Int
hashWithSalt :: Int -> Example -> Int
$chash :: Example -> Int
hash :: Example -> Int
Hashable, Example -> ()
(Example -> ()) -> NFData Example
forall a. (a -> ()) -> NFData a
$crnf :: Example -> ()
rnf :: Example -> ()
NFData)

data ExampleDetails
  = ExamplePath FilePath -- ^ directory where the package is located
  | ExampleHackage ExamplePackage -- ^ package from hackage
  | ExampleScript FilePath -- ^ location of the script we are running
                  [String] -- ^ extra arguments for the script
  deriving (ExampleDetails -> ExampleDetails -> Bool
(ExampleDetails -> ExampleDetails -> Bool)
-> (ExampleDetails -> ExampleDetails -> Bool) -> Eq ExampleDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExampleDetails -> ExampleDetails -> Bool
== :: ExampleDetails -> ExampleDetails -> Bool
$c/= :: ExampleDetails -> ExampleDetails -> Bool
/= :: ExampleDetails -> ExampleDetails -> Bool
Eq, (forall x. ExampleDetails -> Rep ExampleDetails x)
-> (forall x. Rep ExampleDetails x -> ExampleDetails)
-> Generic ExampleDetails
forall x. Rep ExampleDetails x -> ExampleDetails
forall x. ExampleDetails -> Rep ExampleDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExampleDetails -> Rep ExampleDetails x
from :: forall x. ExampleDetails -> Rep ExampleDetails x
$cto :: forall x. Rep ExampleDetails x -> ExampleDetails
to :: forall x. Rep ExampleDetails x -> ExampleDetails
Generic, Int -> ExampleDetails -> ShowS
[ExampleDetails] -> ShowS
ExampleDetails -> String
(Int -> ExampleDetails -> ShowS)
-> (ExampleDetails -> String)
-> ([ExampleDetails] -> ShowS)
-> Show ExampleDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExampleDetails -> ShowS
showsPrec :: Int -> ExampleDetails -> ShowS
$cshow :: ExampleDetails -> String
show :: ExampleDetails -> String
$cshowList :: [ExampleDetails] -> ShowS
showList :: [ExampleDetails] -> ShowS
Show)
  deriving anyclass (Get ExampleDetails
[ExampleDetails] -> Put
ExampleDetails -> Put
(ExampleDetails -> Put)
-> Get ExampleDetails
-> ([ExampleDetails] -> Put)
-> Binary ExampleDetails
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: ExampleDetails -> Put
put :: ExampleDetails -> Put
$cget :: Get ExampleDetails
get :: Get ExampleDetails
$cputList :: [ExampleDetails] -> Put
putList :: [ExampleDetails] -> Put
Binary, Eq ExampleDetails
Eq ExampleDetails =>
(Int -> ExampleDetails -> Int)
-> (ExampleDetails -> Int) -> Hashable ExampleDetails
Int -> ExampleDetails -> Int
ExampleDetails -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ExampleDetails -> Int
hashWithSalt :: Int -> ExampleDetails -> Int
$chash :: ExampleDetails -> Int
hash :: ExampleDetails -> Int
Hashable, ExampleDetails -> ()
(ExampleDetails -> ()) -> NFData ExampleDetails
forall a. (a -> ()) -> NFData a
$crnf :: ExampleDetails -> ()
rnf :: ExampleDetails -> ()
NFData)

instance FromJSON Example where
    parseJSON :: Value -> Parser Example
parseJSON = String -> (Object -> Parser Example) -> Value -> Parser Example
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"example" ((Object -> Parser Example) -> Value -> Parser Example)
-> (Object -> Parser Example) -> Value -> Parser Example
forall a b. (a -> b) -> a -> b
$ \Object
x -> do
        String
exampleName <- Object
x Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        [String]
exampleModules <- Object
x Object -> Key -> Parser [String]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modules"
        [String]
exampleExtraArgs <- [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String])
-> Parser (Maybe [String]) -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extra-args"

        Maybe String
path <- Object
x Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
        case Maybe String
path of
            Just String
examplePath -> do
                Bool
script <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
xObject -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script"
                [String]
args <- [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String])
-> Parser (Maybe [String]) -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script-args"
                let exampleDetails :: ExampleDetails
exampleDetails
                      | Bool
script = String -> [String] -> ExampleDetails
ExampleScript String
examplePath [String]
args
                      | Bool
otherwise = String -> ExampleDetails
ExamplePath String
examplePath
                Example -> Parser Example
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Example{String
[String]
ExampleDetails
exampleName :: String
exampleDetails :: ExampleDetails
exampleModules :: [String]
exampleExtraArgs :: [String]
exampleName :: String
exampleModules :: [String]
exampleExtraArgs :: [String]
exampleDetails :: ExampleDetails
..}
            Maybe String
Nothing -> do
                String
packageName <- Object
x Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"package"
                Version
packageVersion <- Object
x Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
                let exampleDetails :: ExampleDetails
exampleDetails = ExamplePackage -> ExampleDetails
ExampleHackage ExamplePackage{String
Version
packageName :: String
packageVersion :: Version
packageName :: String
packageVersion :: Version
..}
                Example -> Parser Example
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Example{String
[String]
ExampleDetails
exampleName :: String
exampleDetails :: ExampleDetails
exampleModules :: [String]
exampleExtraArgs :: [String]
exampleName :: String
exampleModules :: [String]
exampleExtraArgs :: [String]
exampleDetails :: ExampleDetails
..}

exampleToOptions :: Example -> [String] -> [String]
exampleToOptions :: Example -> [String] -> [String]
exampleToOptions Example{exampleDetails :: Example -> ExampleDetails
exampleDetails = ExampleHackage ExamplePackage{String
Version
packageName :: ExamplePackage -> String
packageVersion :: ExamplePackage -> Version
packageName :: String
packageVersion :: Version
..}, String
[String]
exampleName :: Example -> String
exampleModules :: Example -> [String]
exampleExtraArgs :: Example -> [String]
exampleName :: String
exampleModules :: [String]
exampleExtraArgs :: [String]
..} [String]
extraArgs =
    [String
"--example-package-name", String
packageName
    ,String
"--example-package-version", Version -> String
showVersion Version
packageVersion
    ,String
"--example-name", String
exampleName
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--example-module=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m | String
m <- [String]
exampleModules
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--ghcide-options=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleExtraArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs]
exampleToOptions Example{exampleDetails :: Example -> ExampleDetails
exampleDetails = ExamplePath String
examplePath, String
[String]
exampleName :: Example -> String
exampleModules :: Example -> [String]
exampleExtraArgs :: Example -> [String]
exampleName :: String
exampleModules :: [String]
exampleExtraArgs :: [String]
..} [String]
extraArgs =
    [String
"--example-path", String
examplePath
    ,String
"--example-name", String
exampleName
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--example-module=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m | String
m <- [String]
exampleModules
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--ghcide-options=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleExtraArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs]
exampleToOptions Example{exampleDetails :: Example -> ExampleDetails
exampleDetails = ExampleScript String
examplePath [String]
exampleArgs, String
[String]
exampleName :: Example -> String
exampleModules :: Example -> [String]
exampleExtraArgs :: Example -> [String]
exampleName :: String
exampleModules :: [String]
exampleExtraArgs :: [String]
..} [String]
extraArgs =
    [String
"--example-script", String
examplePath
    ,String
"--example-name", String
exampleName
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--example-script-args=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleArgs
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--example-module=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m | String
m <- [String]
exampleModules
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"--ghcide-options=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleExtraArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs]