{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
module HIE.Bios.Types where

import           System.Exit
import qualified Colog.Core as L
import           Control.Exception              ( Exception )
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import           Prettyprinter
import           System.Process.Extra (CreateProcess (env, cmdspec), CmdSpec (..))

----------------------------------------------------------------
-- Environment variables used by hie-bios.
--
-- If you need more, add a constant here.
----------------------------------------------------------------

-- | Environment variable containing the filepath to which
-- cradle actions write their results to.
-- If the filepath does not exist, cradle actions must create them.
hie_bios_output :: String
hie_bios_output :: [Char]
hie_bios_output = [Char]
"HIE_BIOS_OUTPUT"

-- | Environment variable pointing to the GHC location used by
-- cabal's and stack's GHC wrapper.
--
-- If not set, will default to sensible defaults.
hie_bios_ghc :: String
hie_bios_ghc :: [Char]
hie_bios_ghc = [Char]
"HIE_BIOS_GHC"

-- | Environment variable with extra arguments passed to the GHC location
-- in cabal's and stack's GHC wrapper.
--
-- If not set, assume no extra arguments.
hie_bios_ghc_args :: String
hie_bios_ghc_args :: [Char]
hie_bios_ghc_args = [Char]
"HIE_BIOS_GHC_ARGS"

-- | Environment variable pointing to the source file location that caused
-- the cradle action to be executed.
hie_bios_arg :: String
hie_bios_arg :: [Char]
hie_bios_arg = [Char]
"HIE_BIOS_ARG"

-- | Environment variable pointing to a filepath to which dependencies
-- of a cradle can be written to by the cradle action.
hie_bios_deps :: String
hie_bios_deps :: [Char]
hie_bios_deps = [Char]
"HIE_BIOS_DEPS"

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

-- | 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.
    forall a. Cradle a -> [Char]
cradleRootDir    :: FilePath
  -- | The action which needs to be executed to get the correct
  -- command line arguments.
  , forall a. Cradle a -> CradleAction a
cradleOptsProg   :: CradleAction a
  , forall a. Cradle a -> LogAction IO (WithSeverity Log)
cradleLogger  :: L.LogAction IO (L.WithSeverity Log)
  } deriving ((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
$cfmap :: forall a b. (a -> b) -> Cradle a -> Cradle b
fmap :: forall a b. (a -> b) -> Cradle a -> Cradle b
$c<$ :: forall a b. a -> Cradle b -> Cradle a
<$ :: forall a b. a -> Cradle b -> Cradle a
Functor)

instance Show a => Show (Cradle a) where
  show :: Cradle a -> [Char]
show (Cradle [Char]
root CradleAction a
prog LogAction IO (WithSeverity Log)
_)
    = [Char]
"Cradle{ cradleRootDir = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
root
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
", cradleOptsProg = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CradleAction a -> [Char]
forall a. Show a => a -> [Char]
show CradleAction a
prog
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"}"

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

data Log
  = LogAny !T.Text
  | LogProcessOutput String
  | LogCreateProcessRun CreateProcess
  | LogProcessRun FilePath [FilePath]
  | LogRequestedCradleLoadStyle !T.Text !LoadStyle
  | LogComputedCradleLoadStyle !T.Text !LoadStyle
  | LogLoadWithContextUnsupported !T.Text !(Maybe T.Text)
  deriving (Int -> Log -> ShowS
[Log] -> ShowS
Log -> [Char]
(Int -> Log -> ShowS)
-> (Log -> [Char]) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> [Char]
show :: Log -> [Char]
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show)

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty (LogAny Text
s) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s
  pretty (LogProcessOutput [Char]
s) = [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
s
  pretty (LogProcessRun [Char]
fp [[Char]]
args) = [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
fp Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([[Char]] -> [Char]
unwords [[Char]]
args)
  pretty (LogCreateProcessRun CreateProcess
cp) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [ case CreateProcess -> CmdSpec
cmdspec CreateProcess
cp of
          ShellCommand [Char]
sh -> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
sh
          RawCommand [Char]
cmd [[Char]]
args -> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
cmd Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([[Char]] -> [Char]
unwords [[Char]]
args)
      ]
      [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<>
      if [Doc Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Any]
forall {ann}. [Doc ann]
envText
        then []
        else
          [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Environment Variables"
          , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [Doc ann]
forall {ann}. [Doc ann]
envText
          ]
    where
      envText :: [Doc ann]
envText = ([Char] -> Doc ann) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> ([Char] -> Doc ann) -> [Char] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) ([[Char]] -> [Doc ann]) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ CreateProcess -> [[Char]]
prettyProcessEnv CreateProcess
cp
  pretty (LogRequestedCradleLoadStyle Text
crdlName LoadStyle
ls) =
    Doc ann
"Requested to load" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
crdlName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"cradle" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> case LoadStyle
ls of
      LoadStyle
LoadFile -> Doc ann
"using single file mode"
      LoadWithContext [[Char]]
fps -> Doc ann
"using all files (multi-components):" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 ([[Char]] -> Doc ann
forall ann. [[Char]] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
fps)
  pretty (LogComputedCradleLoadStyle Text
crdlName LoadStyle
ls) =
    Doc ann
"Load" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
crdlName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"cradle" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> case LoadStyle
ls of
      LoadStyle
LoadFile -> Doc ann
"using single file"
      LoadWithContext [[Char]]
_ -> Doc ann
"using all files (multi-components)"

  pretty (LogLoadWithContextUnsupported Text
crdlName Maybe Text
mReason) =
    Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
crdlName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"cradle doesn't support loading using all files (multi-components)" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
      case Maybe Text
mReason of
        Maybe Text
Nothing -> Doc ann
"."
        Just Text
reason -> Doc ann
", because:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
reason Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Falling back loading to single file mode."

-- | The 'LoadStyle' instructs a cradle on how to load a given file target.
data LoadStyle
  = LoadFile
  -- ^ Instruct the cradle to load the given file target.
  --
  -- What this entails depends on the cradle. For example, the 'cabal' cradle
  -- will configure the whole component the file target belongs to, and produce
  -- component options to load the component, which is the minimal unit of code in cabal repl.
  -- A 'default' cradle, on the other hand, will only load the given filepath.
  | LoadWithContext [FilePath]
  -- ^ Give a cradle additional context for loading a file target.
  --
  -- The context instructs the cradle to load the file target, while also loading
  -- the given filepaths.
  -- This is useful for cradles that support loading multiple code units at once,
  -- e.g. cabal cradles can use the 'multi-repl' feature to set up a multiple home unit
  -- session in GHC.
  deriving (Int -> LoadStyle -> ShowS
[LoadStyle] -> ShowS
LoadStyle -> [Char]
(Int -> LoadStyle -> ShowS)
-> (LoadStyle -> [Char])
-> ([LoadStyle] -> ShowS)
-> Show LoadStyle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoadStyle -> ShowS
showsPrec :: Int -> LoadStyle -> ShowS
$cshow :: LoadStyle -> [Char]
show :: LoadStyle -> [Char]
$cshowList :: [LoadStyle] -> ShowS
showList :: [LoadStyle] -> ShowS
Show, LoadStyle -> LoadStyle -> Bool
(LoadStyle -> LoadStyle -> Bool)
-> (LoadStyle -> LoadStyle -> Bool) -> Eq LoadStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoadStyle -> LoadStyle -> Bool
== :: LoadStyle -> LoadStyle -> Bool
$c/= :: LoadStyle -> LoadStyle -> Bool
/= :: LoadStyle -> LoadStyle -> Bool
Eq, Eq LoadStyle
Eq LoadStyle =>
(LoadStyle -> LoadStyle -> Ordering)
-> (LoadStyle -> LoadStyle -> Bool)
-> (LoadStyle -> LoadStyle -> Bool)
-> (LoadStyle -> LoadStyle -> Bool)
-> (LoadStyle -> LoadStyle -> Bool)
-> (LoadStyle -> LoadStyle -> LoadStyle)
-> (LoadStyle -> LoadStyle -> LoadStyle)
-> Ord LoadStyle
LoadStyle -> LoadStyle -> Bool
LoadStyle -> LoadStyle -> Ordering
LoadStyle -> LoadStyle -> LoadStyle
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
$ccompare :: LoadStyle -> LoadStyle -> Ordering
compare :: LoadStyle -> LoadStyle -> Ordering
$c< :: LoadStyle -> LoadStyle -> Bool
< :: LoadStyle -> LoadStyle -> Bool
$c<= :: LoadStyle -> LoadStyle -> Bool
<= :: LoadStyle -> LoadStyle -> Bool
$c> :: LoadStyle -> LoadStyle -> Bool
> :: LoadStyle -> LoadStyle -> Bool
$c>= :: LoadStyle -> LoadStyle -> Bool
>= :: LoadStyle -> LoadStyle -> Bool
$cmax :: LoadStyle -> LoadStyle -> LoadStyle
max :: LoadStyle -> LoadStyle -> LoadStyle
$cmin :: LoadStyle -> LoadStyle -> LoadStyle
min :: LoadStyle -> LoadStyle -> LoadStyle
Ord)

data CradleAction a = CradleAction {
                        forall a. CradleAction a -> ActionName a
actionName    :: ActionName a
                      -- ^ Name of the action.
                      , forall a.
CradleAction a
-> [Char] -> LoadStyle -> IO (CradleLoadResult ComponentOptions)
runCradle     :: FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions)
                      -- ^ Options to compile the given file with.
                      , forall a.
CradleAction a -> [[Char]] -> IO (CradleLoadResult [Char])
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 ((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
$cfmap :: forall a b. (a -> b) -> CradleAction a -> CradleAction b
fmap :: forall a b. (a -> b) -> CradleAction a -> CradleAction b
$c<$ :: forall a b. a -> CradleAction b -> CradleAction a
<$ :: forall a b. a -> CradleAction b -> CradleAction a
Functor)

instance Show a => Show (CradleAction a) where
  show :: CradleAction a -> [Char]
show CradleAction { actionName :: forall a. CradleAction a -> ActionName a
actionName = ActionName a
name } = [Char]
"CradleAction: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ActionName a -> [Char]
forall a. Show a => a -> [Char]
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 ((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
$cfmap :: forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
fmap :: forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
$c<$ :: forall a b. a -> CradleLoadResult b -> CradleLoadResult a
<$ :: forall a b. a -> CradleLoadResult b -> CradleLoadResult a
Functor, (forall m. Monoid m => CradleLoadResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b)
-> (forall a. (a -> a -> a) -> CradleLoadResult a -> a)
-> (forall a. (a -> a -> a) -> CradleLoadResult a -> a)
-> (forall a. CradleLoadResult a -> [a])
-> (forall a. CradleLoadResult a -> Bool)
-> (forall a. CradleLoadResult a -> Int)
-> (forall a. Eq a => a -> CradleLoadResult a -> Bool)
-> (forall a. Ord a => CradleLoadResult a -> a)
-> (forall a. Ord a => CradleLoadResult a -> a)
-> (forall a. Num a => CradleLoadResult a -> a)
-> (forall a. Num a => CradleLoadResult a -> a)
-> Foldable CradleLoadResult
forall a. Eq a => a -> CradleLoadResult a -> Bool
forall a. Num a => CradleLoadResult a -> a
forall a. Ord a => CradleLoadResult a -> a
forall m. Monoid m => CradleLoadResult m -> m
forall a. CradleLoadResult a -> Bool
forall a. CradleLoadResult a -> Int
forall a. CradleLoadResult a -> [a]
forall a. (a -> a -> a) -> CradleLoadResult a -> a
forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m
forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b
forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => CradleLoadResult m -> m
fold :: forall m. Monoid m => CradleLoadResult m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> CradleLoadResult a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CradleLoadResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> CradleLoadResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> CradleLoadResult a -> a
foldr1 :: forall a. (a -> a -> a) -> CradleLoadResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CradleLoadResult a -> a
foldl1 :: forall a. (a -> a -> a) -> CradleLoadResult a -> a
$ctoList :: forall a. CradleLoadResult a -> [a]
toList :: forall a. CradleLoadResult a -> [a]
$cnull :: forall a. CradleLoadResult a -> Bool
null :: forall a. CradleLoadResult a -> Bool
$clength :: forall a. CradleLoadResult a -> Int
length :: forall a. CradleLoadResult a -> Int
$celem :: forall a. Eq a => a -> CradleLoadResult a -> Bool
elem :: forall a. Eq a => a -> CradleLoadResult a -> Bool
$cmaximum :: forall a. Ord a => CradleLoadResult a -> a
maximum :: forall a. Ord a => CradleLoadResult a -> a
$cminimum :: forall a. Ord a => CradleLoadResult a -> a
minimum :: forall a. Ord a => CradleLoadResult a -> a
$csum :: forall a. Num a => CradleLoadResult a -> a
sum :: forall a. Num a => CradleLoadResult a -> a
$cproduct :: forall a. Num a => CradleLoadResult a -> a
product :: forall a. Num a => CradleLoadResult a -> a
Foldable, Functor CradleLoadResult
Foldable CradleLoadResult
(Functor CradleLoadResult, Foldable CradleLoadResult) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> CradleLoadResult a -> f (CradleLoadResult b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CradleLoadResult (f a) -> f (CradleLoadResult a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CradleLoadResult a -> m (CradleLoadResult b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CradleLoadResult (m a) -> m (CradleLoadResult a))
-> Traversable CradleLoadResult
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
CradleLoadResult (m a) -> m (CradleLoadResult a)
forall (f :: * -> *) a.
Applicative f =>
CradleLoadResult (f a) -> f (CradleLoadResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CradleLoadResult a -> m (CradleLoadResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CradleLoadResult a -> f (CradleLoadResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CradleLoadResult a -> f (CradleLoadResult b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CradleLoadResult a -> f (CradleLoadResult b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CradleLoadResult (f a) -> f (CradleLoadResult a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CradleLoadResult (f a) -> f (CradleLoadResult a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CradleLoadResult a -> m (CradleLoadResult b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CradleLoadResult a -> m (CradleLoadResult b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CradleLoadResult (m a) -> m (CradleLoadResult a)
sequence :: forall (m :: * -> *) a.
Monad m =>
CradleLoadResult (m a) -> m (CradleLoadResult a)
Traversable, Int -> CradleLoadResult r -> ShowS
[CradleLoadResult r] -> ShowS
CradleLoadResult r -> [Char]
(Int -> CradleLoadResult r -> ShowS)
-> (CradleLoadResult r -> [Char])
-> ([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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> CradleLoadResult r -> ShowS
showsPrec :: Int -> CradleLoadResult r -> ShowS
$cshow :: forall r. Show r => CradleLoadResult r -> [Char]
show :: CradleLoadResult r -> [Char]
$cshowList :: forall r. Show r => [CradleLoadResult r] -> ShowS
showList :: [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
$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
/= :: CradleLoadResult r -> CradleLoadResult r -> Bool
Eq)

cradleLoadResult :: c -> (CradleError -> c) -> (r -> c) -> CradleLoadResult r -> c
cradleLoadResult :: forall c r.
c -> (CradleError -> c) -> (r -> c) -> CradleLoadResult r -> c
cradleLoadResult c
c CradleError -> c
_ r -> c
_ CradleLoadResult r
CradleNone        = c
c
cradleLoadResult c
_ CradleError -> c
f r -> c
_ (CradleFail CradleError
e)    = CradleError -> c
f CradleError
e
cradleLoadResult c
_ CradleError -> c
_ r -> c
f (CradleSuccess r
r) = r -> c
f r
r

instance Applicative CradleLoadResult where
  pure :: forall a. a -> CradleLoadResult a
pure = a -> CradleLoadResult a
forall a. a -> CradleLoadResult a
CradleSuccess
  CradleSuccess a -> b
a <*> :: forall a b.
CradleLoadResult (a -> b)
-> CradleLoadResult a -> CradleLoadResult b
<*> CradleSuccess a
b = b -> CradleLoadResult b
forall a. a -> CradleLoadResult a
CradleSuccess (a -> b
a a
b)
  CradleFail CradleError
err <*> CradleLoadResult a
_ = CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
  CradleLoadResult (a -> b)
_ <*> CradleFail CradleError
err = CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
  CradleLoadResult (a -> b)
_ <*> CradleLoadResult a
_ = CradleLoadResult b
forall r. CradleLoadResult r
CradleNone

instance Monad CradleLoadResult where
  return :: forall a. a -> CradleLoadResult a
return = a -> CradleLoadResult a
forall a. a -> CradleLoadResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  CradleSuccess a
r >>= :: forall a b.
CradleLoadResult a
-> (a -> CradleLoadResult b) -> CradleLoadResult b
>>= a -> CradleLoadResult b
k = a -> CradleLoadResult b
k a
r
  CradleFail CradleError
err >>= a -> CradleLoadResult b
_ = CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
  CradleLoadResult a
CradleNone >>= a -> CradleLoadResult b
_ = CradleLoadResult b
forall r. CradleLoadResult r
CradleNone

newtype CradleLoadResultT m a = CradleLoadResultT { forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT :: m (CradleLoadResult a) }

instance Functor f => Functor (CradleLoadResultT f) where
  {-# INLINE fmap #-}
  fmap :: forall a b.
(a -> b) -> CradleLoadResultT f a -> CradleLoadResultT f b
fmap a -> b
f = f (CradleLoadResult b) -> CradleLoadResultT f b
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (f (CradleLoadResult b) -> CradleLoadResultT f b)
-> (CradleLoadResultT f a -> f (CradleLoadResult b))
-> CradleLoadResultT f a
-> CradleLoadResultT f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CradleLoadResult a -> CradleLoadResult b)
-> f (CradleLoadResult a) -> f (CradleLoadResult b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CradleLoadResult a -> CradleLoadResult b)
 -> f (CradleLoadResult a) -> f (CradleLoadResult b))
-> ((a -> b) -> CradleLoadResult a -> CradleLoadResult b)
-> (a -> b)
-> f (CradleLoadResult a)
-> f (CradleLoadResult b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (f (CradleLoadResult a) -> f (CradleLoadResult b))
-> (CradleLoadResultT f a -> f (CradleLoadResult a))
-> CradleLoadResultT f a
-> f (CradleLoadResult b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CradleLoadResultT f a -> f (CradleLoadResult a)
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT

instance (Monad m, Applicative m) => Applicative (CradleLoadResultT m) where
  {-# INLINE pure #-}
  pure :: forall a. a -> CradleLoadResultT m a
pure = m (CradleLoadResult a) -> CradleLoadResultT m a
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult a) -> CradleLoadResultT m a)
-> (a -> m (CradleLoadResult a)) -> a -> CradleLoadResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CradleLoadResult a -> m (CradleLoadResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult a -> m (CradleLoadResult a))
-> (a -> CradleLoadResult a) -> a -> m (CradleLoadResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CradleLoadResult a
forall a. a -> CradleLoadResult a
CradleSuccess
  {-# INLINE (<*>) #-}
  CradleLoadResultT m (a -> b)
x <*> :: forall a b.
CradleLoadResultT m (a -> b)
-> CradleLoadResultT m a -> CradleLoadResultT m b
<*> CradleLoadResultT m a
f = m (CradleLoadResult b) -> CradleLoadResultT m b
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult b) -> CradleLoadResultT m b)
-> m (CradleLoadResult b) -> CradleLoadResultT m b
forall a b. (a -> b) -> a -> b
$ do
              CradleLoadResult (a -> b)
a <- CradleLoadResultT m (a -> b) -> m (CradleLoadResult (a -> b))
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT CradleLoadResultT m (a -> b)
x
              case CradleLoadResult (a -> b)
a of
                CradleSuccess a -> b
a' -> do
                  CradleLoadResult a
b <- CradleLoadResultT m a -> m (CradleLoadResult a)
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT CradleLoadResultT m a
f
                  case CradleLoadResult a
b of
                    CradleSuccess a
b' -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> CradleLoadResult b
forall a. a -> CradleLoadResult a
CradleSuccess (a -> b
a' a
b'))
                    CradleFail CradleError
err -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult b -> m (CradleLoadResult b))
-> CradleLoadResult b -> m (CradleLoadResult b)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
                    CradleLoadResult a
CradleNone -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CradleLoadResult b
forall r. CradleLoadResult r
CradleNone
                CradleFail CradleError
err -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult b -> m (CradleLoadResult b))
-> CradleLoadResult b -> m (CradleLoadResult b)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
                CradleLoadResult (a -> b)
CradleNone -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CradleLoadResult b
forall r. CradleLoadResult r
CradleNone

instance Monad m => Monad (CradleLoadResultT m) where
  {-# INLINE return #-}
  return :: forall a. a -> CradleLoadResultT m a
return = a -> CradleLoadResultT m a
forall a. a -> CradleLoadResultT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE (>>=) #-}
  CradleLoadResultT m a
x >>= :: forall a b.
CradleLoadResultT m a
-> (a -> CradleLoadResultT m b) -> CradleLoadResultT m b
>>= a -> CradleLoadResultT m b
f = m (CradleLoadResult b) -> CradleLoadResultT m b
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult b) -> CradleLoadResultT m b)
-> m (CradleLoadResult b) -> CradleLoadResultT m b
forall a b. (a -> b) -> a -> b
$ do
    CradleLoadResult a
val <- CradleLoadResultT m a -> m (CradleLoadResult a)
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT CradleLoadResultT m a
x
    case CradleLoadResult a
val of
      CradleSuccess a
r -> CradleLoadResultT m b -> m (CradleLoadResult b)
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT (CradleLoadResultT m b -> m (CradleLoadResult b))
-> (a -> CradleLoadResultT m b) -> a -> m (CradleLoadResult b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CradleLoadResultT m b
f (a -> m (CradleLoadResult b)) -> a -> m (CradleLoadResult b)
forall a b. (a -> b) -> a -> b
$ a
r
      CradleFail CradleError
err -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleLoadResult b -> m (CradleLoadResult b))
-> CradleLoadResult b -> m (CradleLoadResult b)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult b
forall r. CradleError -> CradleLoadResult r
CradleFail CradleError
err
      CradleLoadResult a
CradleNone -> CradleLoadResult b -> m (CradleLoadResult b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleLoadResult b -> m (CradleLoadResult b))
-> CradleLoadResult b -> m (CradleLoadResult b)
forall a b. (a -> b) -> a -> b
$ CradleLoadResult b
forall r. CradleLoadResult r
CradleNone
#if !(MIN_VERSION_base(4,13,0))
  fail = CradleLoadResultT . fail
  {-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail m => Fail.MonadFail (CradleLoadResultT m) where
  fail :: forall a. [Char] -> CradleLoadResultT m a
fail = m (CradleLoadResult a) -> CradleLoadResultT m a
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult a) -> CradleLoadResultT m a)
-> ([Char] -> m (CradleLoadResult a))
-> [Char]
-> CradleLoadResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m (CradleLoadResult a)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail
  {-# INLINE fail #-}
#endif

instance MonadTrans CradleLoadResultT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> CradleLoadResultT m a
lift = m (CradleLoadResult a) -> CradleLoadResultT m a
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult a) -> CradleLoadResultT m a)
-> (m a -> m (CradleLoadResult a)) -> m a -> CradleLoadResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CradleLoadResult a) -> m a -> m (CradleLoadResult a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> CradleLoadResult a
forall a. a -> CradleLoadResult a
CradleSuccess
    {-# INLINE lift #-}

instance (MonadIO m) => MonadIO (CradleLoadResultT m) where
    liftIO :: forall a. IO a -> CradleLoadResultT m a
liftIO = m a -> CradleLoadResultT m a
forall (m :: * -> *) a. Monad m => m a -> CradleLoadResultT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CradleLoadResultT m a)
-> (IO a -> m a) -> IO a -> CradleLoadResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    {-# INLINE liftIO #-}

modCradleError :: Monad m => CradleLoadResultT m a -> (CradleError -> m CradleError) -> CradleLoadResultT m a
modCradleError :: forall (m :: * -> *) a.
Monad m =>
CradleLoadResultT m a
-> (CradleError -> m CradleError) -> CradleLoadResultT m a
modCradleError CradleLoadResultT m a
action CradleError -> m CradleError
f = m (CradleLoadResult a) -> CradleLoadResultT m a
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult a) -> CradleLoadResultT m a)
-> m (CradleLoadResult a) -> CradleLoadResultT m a
forall a b. (a -> b) -> a -> b
$ do
  CradleLoadResult a
a <- CradleLoadResultT m a -> m (CradleLoadResult a)
forall (m :: * -> *) a.
CradleLoadResultT m a -> m (CradleLoadResult a)
runCradleResultT CradleLoadResultT m a
action
  case CradleLoadResult a
a of
    CradleFail CradleError
err -> CradleError -> CradleLoadResult a
forall r. CradleError -> CradleLoadResult r
CradleFail (CradleError -> CradleLoadResult a)
-> m CradleError -> m (CradleLoadResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CradleError -> m CradleError
f CradleError
err
    CradleLoadResult a
_ -> CradleLoadResult a -> m (CradleLoadResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CradleLoadResult a
a

throwCE :: Monad m => CradleError -> CradleLoadResultT m a
throwCE :: forall (m :: * -> *) a.
Monad m =>
CradleError -> CradleLoadResultT m a
throwCE = m (CradleLoadResult a) -> CradleLoadResultT m a
forall (m :: * -> *) a.
m (CradleLoadResult a) -> CradleLoadResultT m a
CradleLoadResultT (m (CradleLoadResult a) -> CradleLoadResultT m a)
-> (CradleError -> m (CradleLoadResult a))
-> CradleError
-> CradleLoadResultT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CradleLoadResult a -> m (CradleLoadResult a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleLoadResult a -> m (CradleLoadResult a))
-> (CradleError -> CradleLoadResult a)
-> CradleError
-> m (CradleLoadResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CradleError -> CradleLoadResult a
forall r. CradleError -> CradleLoadResult r
CradleFail

data CradleError = CradleError
  { CradleError -> [[Char]]
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 -> [[Char]]
cradleErrorStderr :: [String]
  -- ^ Standard error output that can be shown to users to explain
  -- the loading error.
  }
  deriving (Int -> CradleError -> ShowS
[CradleError] -> ShowS
CradleError -> [Char]
(Int -> CradleError -> ShowS)
-> (CradleError -> [Char])
-> ([CradleError] -> ShowS)
-> Show CradleError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CradleError -> ShowS
showsPrec :: Int -> CradleError -> ShowS
$cshow :: CradleError -> [Char]
show :: CradleError -> [Char]
$cshowList :: [CradleError] -> ShowS
showList :: [CradleError] -> ShowS
Show, CradleError -> CradleError -> Bool
(CradleError -> CradleError -> Bool)
-> (CradleError -> CradleError -> Bool) -> Eq CradleError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CradleError -> CradleError -> Bool
== :: CradleError -> CradleError -> Bool
$c/= :: CradleError -> CradleError -> Bool
/= :: CradleError -> CradleError -> Bool
Eq)

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

-- | Option information for GHC
data ComponentOptions = ComponentOptions {
    ComponentOptions -> [[Char]]
componentOptions  :: [String]  -- ^ Command line options.
  , ComponentOptions -> [Char]
componentRoot :: FilePath
  -- ^ Root directory of the component. All 'componentOptions' are either
  -- absolute, or relative to this directory.
  , ComponentOptions -> [[Char]]
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
$c== :: ComponentOptions -> ComponentOptions -> Bool
== :: ComponentOptions -> ComponentOptions -> Bool
$c/= :: ComponentOptions -> ComponentOptions -> Bool
/= :: 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
$ccompare :: ComponentOptions -> ComponentOptions -> Ordering
compare :: ComponentOptions -> ComponentOptions -> Ordering
$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
>= :: ComponentOptions -> ComponentOptions -> Bool
$cmax :: ComponentOptions -> ComponentOptions -> ComponentOptions
max :: ComponentOptions -> ComponentOptions -> ComponentOptions
$cmin :: ComponentOptions -> ComponentOptions -> ComponentOptions
min :: ComponentOptions -> ComponentOptions -> ComponentOptions
Ord, Int -> ComponentOptions -> ShowS
[ComponentOptions] -> ShowS
ComponentOptions -> [Char]
(Int -> ComponentOptions -> ShowS)
-> (ComponentOptions -> [Char])
-> ([ComponentOptions] -> ShowS)
-> Show ComponentOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentOptions -> ShowS
showsPrec :: Int -> ComponentOptions -> ShowS
$cshow :: ComponentOptions -> [Char]
show :: ComponentOptions -> [Char]
$cshowList :: [ComponentOptions] -> ShowS
showList :: [ComponentOptions] -> ShowS
Show)


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

-- | Prettify 'CmdSpec', so we can show the command to a user
prettyCmdSpec :: CmdSpec -> String
prettyCmdSpec :: CmdSpec -> [Char]
prettyCmdSpec (ShellCommand [Char]
s) = [Char]
s
prettyCmdSpec (RawCommand [Char]
cmd [[Char]]
args) = [Char]
cmd [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
args

-- | Pretty print hie-bios's relevant environment variables.
prettyProcessEnv :: CreateProcess -> [String]
prettyProcessEnv :: CreateProcess -> [[Char]]
prettyProcessEnv CreateProcess
p =
  [ [Char]
key [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
value
  | ([Char]
key, [Char]
value) <- [([Char], [Char])]
-> Maybe [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> Maybe a -> a
fromMaybe [] (CreateProcess -> Maybe [([Char], [Char])]
env CreateProcess
p)
  , [Char]
key [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ [Char]
hie_bios_output
               , [Char]
hie_bios_ghc
               , [Char]
hie_bios_ghc_args
               , [Char]
hie_bios_arg
               , [Char]
hie_bios_deps
               ]
  ]