{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalStack -> CabalStack -> Bool
$c/= :: CabalStack -> CabalStack -> Bool
== :: CabalStack -> CabalStack -> Bool
$c== :: CabalStack -> CabalStack -> Bool
Eq, Int -> CabalStack -> ShowS
[CabalStack] -> ShowS
CabalStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalStack] -> ShowS
$cshowList :: [CabalStack] -> ShowS
show :: CabalStack -> String
$cshow :: CabalStack -> String
showsPrec :: Int -> CabalStack -> ShowS
$cshowsPrec :: Int -> CabalStack -> ShowS
Show)

data Verbosity = Quiet | Normal | All
  deriving (Verbosity -> Verbosity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

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

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

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

        Maybe String
path <- Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
        case Maybe String
path of
            Just String
examplePath -> do
                let exampleDetails :: Either String b
exampleDetails = forall a b. a -> Either a b
Left String
examplePath
                forall (m :: * -> *) a. Monad m => a -> m a
return Example{String
[String]
forall {b}. Either String b
exampleDetails :: forall {b}. Either String b
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleName :: String
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleDetails :: Either String ExamplePackage
exampleName :: String
..}
            Maybe String
Nothing -> do
                String
packageName <- Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"package"
                Version
packageVersion <- Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
                let exampleDetails :: Either a ExamplePackage
exampleDetails = forall a b. b -> Either a b
Right ExamplePackage{String
Version
packageVersion :: Version
packageName :: String
packageVersion :: Version
packageName :: String
..}
                forall (m :: * -> *) a. Monad m => a -> m a
return Example{String
[String]
forall {a}. Either a ExamplePackage
exampleDetails :: forall {a}. Either a ExamplePackage
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleName :: String
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleDetails :: Either String ExamplePackage
exampleName :: String
..}

exampleToOptions :: Example -> [String] -> [String]
exampleToOptions :: Example -> [String] -> [String]
exampleToOptions Example{exampleDetails :: Example -> Either String ExamplePackage
exampleDetails = Right ExamplePackage{String
Version
packageVersion :: Version
packageName :: String
packageVersion :: ExamplePackage -> Version
packageName :: ExamplePackage -> String
..}, String
[String]
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleName :: String
exampleExtraArgs :: Example -> [String]
exampleModules :: Example -> [String]
exampleName :: Example -> String
..} [String]
extraArgs =
    [String
"--example-package-name", String
packageName
    ,String
"--example-package-version", Version -> String
showVersion Version
packageVersion
    ] forall a. [a] -> [a] -> [a]
++
    [String
"--example-module=" forall a. Semigroup a => a -> a -> a
<> String
m | String
m <- [String]
exampleModules
    ] forall a. [a] -> [a] -> [a]
++
    [String
"--ghcide-options=" forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleExtraArgs forall a. [a] -> [a] -> [a]
++ [String]
extraArgs]
exampleToOptions Example{exampleDetails :: Example -> Either String ExamplePackage
exampleDetails = Left String
examplePath, String
[String]
exampleExtraArgs :: [String]
exampleModules :: [String]
exampleName :: String
exampleExtraArgs :: Example -> [String]
exampleModules :: Example -> [String]
exampleName :: Example -> String
..} [String]
extraArgs =
    [String
"--example-path", String
examplePath
    ] forall a. [a] -> [a] -> [a]
++
    [String
"--example-module=" forall a. Semigroup a => a -> a -> a
<> String
m | String
m <- [String]
exampleModules
    ] forall a. [a] -> [a] -> [a]
++
    [String
"--ghcide-options=" forall a. Semigroup a => a -> a -> a
<> String
o | String
o <- [String]
exampleExtraArgs forall a. [a] -> [a] -> [a]
++ [String]
extraArgs]