{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module HIE.Bios.Types where

import           System.Exit
import           System.IO
import           Control.Exception              ( Exception )

data BIOSVerbosity = Silent | Verbose

data CradleOpts = CradleOpts
                { CradleOpts -> BIOSVerbosity
cradleOptsVerbosity :: BIOSVerbosity
                , CradleOpts -> Maybe Handle
cradleOptsHandle :: Maybe Handle
                -- ^ The handle where to send output to, if not set, stderr.
                }

defaultCradleOpts :: CradleOpts
defaultCradleOpts :: CradleOpts
defaultCradleOpts = BIOSVerbosity -> Maybe Handle -> CradleOpts
CradleOpts BIOSVerbosity
Silent Maybe Handle
forall a. Maybe a
Nothing

----------------------------------------------------------------

-- | The environment of a single 'Cradle'.
-- A 'Cradle' is a unit for the respective build-system.
--
-- It contains the root directory of the 'Cradle', the name of
-- the 'Cradle' (for debugging purposes), and knows how to set up
-- a GHC session that is able to compile files that are part of this 'Cradle'.
--
-- A 'Cradle' may be a single unit in the \"cabal-install\" context, or
-- the whole package, comparable to how \"stack\" works.
data Cradle a = Cradle {
  -- | The project root directory.
    Cradle a -> FilePath
cradleRootDir    :: FilePath
  -- | The action which needs to be executed to get the correct
  -- command line arguments.
  , Cradle a -> CradleAction a
cradleOptsProg   :: CradleAction a
  } deriving (Int -> Cradle a -> ShowS
[Cradle a] -> ShowS
Cradle a -> FilePath
(Int -> Cradle a -> ShowS)
-> (Cradle a -> FilePath)
-> ([Cradle a] -> ShowS)
-> Show (Cradle a)
forall a. Show a => Int -> Cradle a -> ShowS
forall a. Show a => [Cradle a] -> ShowS
forall a. Show a => Cradle a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Cradle a] -> ShowS
$cshowList :: forall a. Show a => [Cradle a] -> ShowS
show :: Cradle a -> FilePath
$cshow :: forall a. Show a => Cradle a -> FilePath
showsPrec :: Int -> Cradle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cradle a -> ShowS
Show, a -> Cradle b -> Cradle a
(a -> b) -> Cradle a -> Cradle b
(forall a b. (a -> b) -> Cradle a -> Cradle b)
-> (forall a b. a -> Cradle b -> Cradle a) -> Functor Cradle
forall a b. a -> Cradle b -> Cradle a
forall a b. (a -> b) -> Cradle a -> Cradle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Cradle b -> Cradle a
$c<$ :: forall a b. a -> Cradle b -> Cradle a
fmap :: (a -> b) -> Cradle a -> Cradle b
$cfmap :: forall a b. (a -> b) -> Cradle a -> Cradle b
Functor)

type LoggingFunction = String -> IO ()

data ActionName a
  = Stack
  | Cabal
  | Bios
  | Default
  | Multi
  | Direct
  | None
  | Other a
  deriving (Int -> ActionName a -> ShowS
[ActionName a] -> ShowS
ActionName a -> FilePath
(Int -> ActionName a -> ShowS)
-> (ActionName a -> FilePath)
-> ([ActionName a] -> ShowS)
-> Show (ActionName a)
forall a. Show a => Int -> ActionName a -> ShowS
forall a. Show a => [ActionName a] -> ShowS
forall a. Show a => ActionName a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ActionName a] -> ShowS
$cshowList :: forall a. Show a => [ActionName a] -> ShowS
show :: ActionName a -> FilePath
$cshow :: forall a. Show a => ActionName a -> FilePath
showsPrec :: Int -> ActionName a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ActionName a -> ShowS
Show, ActionName a -> ActionName a -> Bool
(ActionName a -> ActionName a -> Bool)
-> (ActionName a -> ActionName a -> Bool) -> Eq (ActionName a)
forall a. Eq a => ActionName a -> ActionName a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionName a -> ActionName a -> Bool
$c/= :: forall a. Eq a => ActionName a -> ActionName a -> Bool
== :: ActionName a -> ActionName a -> Bool
$c== :: forall a. Eq a => ActionName a -> ActionName a -> Bool
Eq, Eq (ActionName a)
Eq (ActionName a) =>
(ActionName a -> ActionName a -> Ordering)
-> (ActionName a -> ActionName a -> Bool)
-> (ActionName a -> ActionName a -> Bool)
-> (ActionName a -> ActionName a -> Bool)
-> (ActionName a -> ActionName a -> Bool)
-> (ActionName a -> ActionName a -> ActionName a)
-> (ActionName a -> ActionName a -> ActionName a)
-> Ord (ActionName a)
ActionName a -> ActionName a -> Bool
ActionName a -> ActionName a -> Ordering
ActionName a -> ActionName a -> ActionName a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ActionName a)
forall a. Ord a => ActionName a -> ActionName a -> Bool
forall a. Ord a => ActionName a -> ActionName a -> Ordering
forall a. Ord a => ActionName a -> ActionName a -> ActionName a
min :: ActionName a -> ActionName a -> ActionName a
$cmin :: forall a. Ord a => ActionName a -> ActionName a -> ActionName a
max :: ActionName a -> ActionName a -> ActionName a
$cmax :: forall a. Ord a => ActionName a -> ActionName a -> ActionName a
>= :: ActionName a -> ActionName a -> Bool
$c>= :: forall a. Ord a => ActionName a -> ActionName a -> Bool
> :: ActionName a -> ActionName a -> Bool
$c> :: forall a. Ord a => ActionName a -> ActionName a -> Bool
<= :: ActionName a -> ActionName a -> Bool
$c<= :: forall a. Ord a => ActionName a -> ActionName a -> Bool
< :: ActionName a -> ActionName a -> Bool
$c< :: forall a. Ord a => ActionName a -> ActionName a -> Bool
compare :: ActionName a -> ActionName a -> Ordering
$ccompare :: forall a. Ord a => ActionName a -> ActionName a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ActionName a)
Ord, a -> ActionName b -> ActionName a
(a -> b) -> ActionName a -> ActionName b
(forall a b. (a -> b) -> ActionName a -> ActionName b)
-> (forall a b. a -> ActionName b -> ActionName a)
-> Functor ActionName
forall a b. a -> ActionName b -> ActionName a
forall a b. (a -> b) -> ActionName a -> ActionName b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ActionName b -> ActionName a
$c<$ :: forall a b. a -> ActionName b -> ActionName a
fmap :: (a -> b) -> ActionName a -> ActionName b
$cfmap :: forall a b. (a -> b) -> ActionName a -> ActionName b
Functor)

data CradleAction a = CradleAction {
                        CradleAction a -> ActionName a
actionName    :: ActionName a
                      -- ^ Name of the action.
                      , CradleAction a
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
runCradle     :: LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions)
                      -- ^ Options to compile the given file with.
                      , CradleAction a -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd :: [String] -> IO (CradleLoadResult String)
                      -- ^ Executes the @ghc@ binary that is usually used to
                      -- build the cradle. E.g. for a cabal cradle this should be
                      -- equivalent to @cabal exec ghc -- args@
                      }
  deriving (a -> CradleAction b -> CradleAction a
(a -> b) -> CradleAction a -> CradleAction b
(forall a b. (a -> b) -> CradleAction a -> CradleAction b)
-> (forall a b. a -> CradleAction b -> CradleAction a)
-> Functor CradleAction
forall a b. a -> CradleAction b -> CradleAction a
forall a b. (a -> b) -> CradleAction a -> CradleAction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CradleAction b -> CradleAction a
$c<$ :: forall a b. a -> CradleAction b -> CradleAction a
fmap :: (a -> b) -> CradleAction a -> CradleAction b
$cfmap :: forall a b. (a -> b) -> CradleAction a -> CradleAction b
Functor)

instance Show a => Show (CradleAction a) where
  show :: CradleAction a -> FilePath
show CradleAction { actionName :: forall a. CradleAction a -> ActionName a
actionName = ActionName a
name } = "CradleAction: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ActionName a -> FilePath
forall a. Show a => a -> FilePath
show ActionName a
name

-- | Result of an attempt to set up a GHC session for a 'Cradle'.
-- This is the go-to error handling mechanism. When possible, this
-- should be preferred over throwing exceptions.
data CradleLoadResult r
  = CradleSuccess r -- ^ The cradle succeeded and returned these options.
  | CradleFail CradleError -- ^ We tried to load the cradle and it failed.
  | CradleNone -- ^ No attempt was made to load the cradle.
  deriving (a -> CradleLoadResult b -> CradleLoadResult a
(a -> b) -> CradleLoadResult a -> CradleLoadResult b
(forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b)
-> (forall a b. a -> CradleLoadResult b -> CradleLoadResult a)
-> Functor CradleLoadResult
forall a b. a -> CradleLoadResult b -> CradleLoadResult a
forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CradleLoadResult b -> CradleLoadResult a
$c<$ :: forall a b. a -> CradleLoadResult b -> CradleLoadResult a
fmap :: (a -> b) -> CradleLoadResult a -> CradleLoadResult b
$cfmap :: forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
Functor, Int -> CradleLoadResult r -> ShowS
[CradleLoadResult r] -> ShowS
CradleLoadResult r -> FilePath
(Int -> CradleLoadResult r -> ShowS)
-> (CradleLoadResult r -> FilePath)
-> ([CradleLoadResult r] -> ShowS)
-> Show (CradleLoadResult r)
forall r. Show r => Int -> CradleLoadResult r -> ShowS
forall r. Show r => [CradleLoadResult r] -> ShowS
forall r. Show r => CradleLoadResult r -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CradleLoadResult r] -> ShowS
$cshowList :: forall r. Show r => [CradleLoadResult r] -> ShowS
show :: CradleLoadResult r -> FilePath
$cshow :: forall r. Show r => CradleLoadResult r -> FilePath
showsPrec :: Int -> CradleLoadResult r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> CradleLoadResult r -> ShowS
Show, CradleLoadResult r -> CradleLoadResult r -> Bool
(CradleLoadResult r -> CradleLoadResult r -> Bool)
-> (CradleLoadResult r -> CradleLoadResult r -> Bool)
-> Eq (CradleLoadResult r)
forall r. Eq r => CradleLoadResult r -> CradleLoadResult r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CradleLoadResult r -> CradleLoadResult r -> Bool
$c/= :: forall r. Eq r => CradleLoadResult r -> CradleLoadResult r -> Bool
== :: CradleLoadResult r -> CradleLoadResult r -> Bool
$c== :: forall r. Eq r => CradleLoadResult r -> CradleLoadResult r -> Bool
Eq)


data CradleError = CradleError
  { CradleError -> [FilePath]
cradleErrorDependencies :: [FilePath]
  -- ^ Dependencies of the cradle that failed to load.
  -- Can be watched for changes to attempt a reload of the cradle.
  , CradleError -> ExitCode
cradleErrorExitCode :: ExitCode
  -- ^ ExitCode of the cradle loading mechanism.
  , CradleError -> [FilePath]
cradleErrorStderr :: [String]
  -- ^ Standard error output that can be shown to users to explain
  -- the loading error.
  }
  deriving (Int -> CradleError -> ShowS
[CradleError] -> ShowS
CradleError -> FilePath
(Int -> CradleError -> ShowS)
-> (CradleError -> FilePath)
-> ([CradleError] -> ShowS)
-> Show CradleError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CradleError] -> ShowS
$cshowList :: [CradleError] -> ShowS
show :: CradleError -> FilePath
$cshow :: CradleError -> FilePath
showsPrec :: Int -> CradleError -> ShowS
$cshowsPrec :: Int -> CradleError -> ShowS
Show, CradleError -> CradleError -> Bool
(CradleError -> CradleError -> Bool)
-> (CradleError -> CradleError -> Bool) -> Eq CradleError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CradleError -> CradleError -> Bool
$c/= :: CradleError -> CradleError -> Bool
== :: CradleError -> CradleError -> Bool
$c== :: CradleError -> CradleError -> Bool
Eq)

instance Exception CradleError where
----------------------------------------------------------------

-- | Option information for GHC
data ComponentOptions = ComponentOptions {
    ComponentOptions -> [FilePath]
componentOptions  :: [String]  -- ^ Command line options.
  , ComponentOptions -> FilePath
componentRoot :: FilePath
  -- ^ Root directory of the component. All 'componentOptions' are either
  -- absolute, or relative to this directory.
  , ComponentOptions -> [FilePath]
componentDependencies :: [FilePath]
  -- ^ Dependencies of a cradle that might change the cradle.
  -- Contains both files specified in hie.yaml as well as
  -- specified by the build-tool if there is any.
  -- FilePaths are expected to be relative to the `cradleRootDir`
  -- to which this CradleAction belongs to.
  -- Files returned by this action might not actually exist.
  -- This is useful, because, sometimes, adding specific files
  -- changes the options that a Cradle may return, thus, needs reload
  -- as soon as these files are created.
  } deriving (ComponentOptions -> ComponentOptions -> Bool
(ComponentOptions -> ComponentOptions -> Bool)
-> (ComponentOptions -> ComponentOptions -> Bool)
-> Eq ComponentOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentOptions -> ComponentOptions -> Bool
$c/= :: ComponentOptions -> ComponentOptions -> Bool
== :: ComponentOptions -> ComponentOptions -> Bool
$c== :: ComponentOptions -> ComponentOptions -> Bool
Eq, Eq ComponentOptions
Eq ComponentOptions =>
(ComponentOptions -> ComponentOptions -> Ordering)
-> (ComponentOptions -> ComponentOptions -> Bool)
-> (ComponentOptions -> ComponentOptions -> Bool)
-> (ComponentOptions -> ComponentOptions -> Bool)
-> (ComponentOptions -> ComponentOptions -> Bool)
-> (ComponentOptions -> ComponentOptions -> ComponentOptions)
-> (ComponentOptions -> ComponentOptions -> ComponentOptions)
-> Ord ComponentOptions
ComponentOptions -> ComponentOptions -> Bool
ComponentOptions -> ComponentOptions -> Ordering
ComponentOptions -> ComponentOptions -> ComponentOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentOptions -> ComponentOptions -> ComponentOptions
$cmin :: ComponentOptions -> ComponentOptions -> ComponentOptions
max :: ComponentOptions -> ComponentOptions -> ComponentOptions
$cmax :: ComponentOptions -> ComponentOptions -> ComponentOptions
>= :: ComponentOptions -> ComponentOptions -> Bool
$c>= :: ComponentOptions -> ComponentOptions -> Bool
> :: ComponentOptions -> ComponentOptions -> Bool
$c> :: ComponentOptions -> ComponentOptions -> Bool
<= :: ComponentOptions -> ComponentOptions -> Bool
$c<= :: ComponentOptions -> ComponentOptions -> Bool
< :: ComponentOptions -> ComponentOptions -> Bool
$c< :: ComponentOptions -> ComponentOptions -> Bool
compare :: ComponentOptions -> ComponentOptions -> Ordering
$ccompare :: ComponentOptions -> ComponentOptions -> Ordering
$cp1Ord :: Eq ComponentOptions
Ord, Int -> ComponentOptions -> ShowS
[ComponentOptions] -> ShowS
ComponentOptions -> FilePath
(Int -> ComponentOptions -> ShowS)
-> (ComponentOptions -> FilePath)
-> ([ComponentOptions] -> ShowS)
-> Show ComponentOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComponentOptions] -> ShowS
$cshowList :: [ComponentOptions] -> ShowS
show :: ComponentOptions -> FilePath
$cshow :: ComponentOptions -> FilePath
showsPrec :: Int -> ComponentOptions -> ShowS
$cshowsPrec :: Int -> ComponentOptions -> ShowS
Show)