{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |

-- Module      :  BuildEnv.Config

-- Description :  Configuration options for @build-env@

--

-- Configuration options for @build-env@

module BuildEnv.Config
  ( -- * Build strategy

    BuildStrategy(..), RunStrategy(..)
  , AsyncSem(..), semDescription

   -- * Passing arguments

  , Args, UnitArgs(..)

    -- * @ghc@ and @cabal-install@ executables

  , Compiler(..), Cabal(..)

    -- * Directory structure

  , Paths(..), BuildPaths(..)
  , PathUsability(..)
  , canonicalizePaths

    -- ** Handling of temporary directories

  , TempDirPermanence(..)

    -- * Logging verbosity

  , Verbosity(.., Quiet, Normal, Verbose, Debug)
  , quietMsg, normalMsg, verboseMsg, debugMsg
  , ghcVerbosity, ghcPkgVerbosity, cabalVerbosity, setupVerbosity

    -- * Reporting progress

  , Counter(..)

    -- * OS specifics

  , Style(..), hostStyle
  , pATHSeparator

  ) where

-- base

import Control.Monad
  ( when )
import Data.Kind
  ( Type )
import Data.IORef
  ( IORef )
import Data.Word
  ( Word16 )
import System.IO
  ( hFlush, stdout )

-- directory

import System.Directory
  ( canonicalizePath )

-- filepath

import System.FilePath
  ( (</>), dropDrive )

-- text

import Data.Text
  ( Text )
import qualified Data.Text as Text
  ( pack )
import qualified Data.Text.IO as Text
  ( putStrLn )

-- time

import Data.Time.Clock
  ( getCurrentTime )
import Data.Time.Format
  ( defaultTimeLocale, formatTime )

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

-- Build strategy


-- | Build strategy for 'BuildEnv.Build.buildPlan'.

data BuildStrategy
  -- | Execute the build plan in-place.

  = Execute RunStrategy
  -- | Output a build script that can be run later.

  | Script
    { BuildStrategy -> String
scriptPath   :: !FilePath
      -- ^ Output path at which to write the build script.

    , BuildStrategy -> Bool
useVariables :: !Bool
      -- ^ Should the output shell script use variables, or baked in paths?

      --

      -- The shell script will use the following variables:

      --

      -- - @GHC@, @GHCPKG@, @SOURCES@, @PREFIX@, @DESTDIR@.

    }
  deriving stock Int -> BuildStrategy -> ShowS
[BuildStrategy] -> ShowS
BuildStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildStrategy] -> ShowS
$cshowList :: [BuildStrategy] -> ShowS
show :: BuildStrategy -> String
$cshow :: BuildStrategy -> String
showsPrec :: Int -> BuildStrategy -> ShowS
$cshowsPrec :: Int -> BuildStrategy -> ShowS
Show

-- | How to execute a build plan.

data RunStrategy
  -- | Topologically sort the cabal build plan, and build the

  -- packages in sequence.

  = TopoSort
  -- | Asynchronously build all the packages, with each package

  -- waiting on its dependencies.

  | Async
     AsyncSem
       -- ^ The kind of semaphore to use to control concurrency.

  deriving stock Int -> RunStrategy -> ShowS
[RunStrategy] -> ShowS
RunStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunStrategy] -> ShowS
$cshowList :: [RunStrategy] -> ShowS
show :: RunStrategy -> String
$cshow :: RunStrategy -> String
showsPrec :: Int -> RunStrategy -> ShowS
$cshowsPrec :: Int -> RunStrategy -> ShowS
Show

-- | What kind of semaphore to use in 'BuildEnv.Build.buildPlan'?

--

-- NB: this datatype depends on whether the @jsem@ flag

-- was enabled when building the @build-env@ package.

data AsyncSem
  -- | Don't use any semaphore (not recommended).

  = NoSem
  -- | Create a new 'Control.Concurrent.QSem.QSem' semaphore

  -- with the given number of tokens.

  | NewQSem !Word16
  deriving stock Int -> AsyncSem -> ShowS
[AsyncSem] -> ShowS
AsyncSem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsyncSem] -> ShowS
$cshowList :: [AsyncSem] -> ShowS
show :: AsyncSem -> String
$cshow :: AsyncSem -> String
showsPrec :: Int -> AsyncSem -> ShowS
$cshowsPrec :: Int -> AsyncSem -> ShowS
Show

-- | A description of the kind of semaphore we are using to control concurrency.

semDescription :: AsyncSem -> Text
semDescription :: AsyncSem -> Text
semDescription = \case
  AsyncSem
NoSem     -> Text
"no semaphore"
  NewQSem Word16
i -> Text
"-j" forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Word16
i)

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

-- Arguments


-- | A type synonym for command-line arguments.

type Args = [String]

-- | Arguments specific to a unit.

data UnitArgs =
  UnitArgs { UnitArgs -> Args
configureArgs :: !Args
               -- ^ Arguments to @Setup configure@.

           , UnitArgs -> Maybe Args
mbHaddockArgs :: !(Maybe Args)
               -- ^ Arguments to @Setup haddock@.

               -- @Nothing@ means: skip @Setup haddock@.

           , UnitArgs -> Args
registerArgs  :: !Args
               -- ^ Arguments to @ghc-pkg register@.

           }
  deriving stock Int -> UnitArgs -> ShowS
[UnitArgs] -> ShowS
UnitArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitArgs] -> ShowS
$cshowList :: [UnitArgs] -> ShowS
show :: UnitArgs -> String
$cshow :: UnitArgs -> String
showsPrec :: Int -> UnitArgs -> ShowS
$cshowsPrec :: Int -> UnitArgs -> ShowS
Show

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

-- GHC & cabal-install


-- | Path to the @cabal-install@ executable.

data Cabal = Cabal { Cabal -> String
cabalPath       :: !FilePath
                   , Cabal -> Args
globalCabalArgs :: !Args
                     -- ^ Arguments to pass to all @cabal@ invocations,

                     -- before any @cabal@ command.

                   }
  deriving stock Int -> Cabal -> ShowS
[Cabal] -> ShowS
Cabal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cabal] -> ShowS
$cshowList :: [Cabal] -> ShowS
show :: Cabal -> String
$cshow :: Cabal -> String
showsPrec :: Int -> Cabal -> ShowS
$cshowsPrec :: Int -> Cabal -> ShowS
Show

-- | Paths to the @ghc@ and @ghc-pkg@ executables.

data Compiler =
  Compiler { Compiler -> String
ghcPath    :: !FilePath
           , Compiler -> String
ghcPkgPath :: !FilePath
           }
  deriving stock Int -> Compiler -> ShowS
[Compiler] -> ShowS
Compiler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compiler] -> ShowS
$cshowList :: [Compiler] -> ShowS
show :: Compiler -> String
$cshow :: Compiler -> String
showsPrec :: Int -> Compiler -> ShowS
$cshowsPrec :: Int -> Compiler -> ShowS
Show

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

-- Directory structure


-- | The directory structure relevant to preparing and carrying out

-- a build plan.

type Paths :: PathUsability -> Type
data Paths use
  = Paths
    { forall (use :: PathUsability). Paths use -> String
fetchDir   :: !FilePath
       -- ^ Input fetched sources directory.

    , forall (use :: PathUsability). Paths use -> BuildPaths use
buildPaths :: BuildPaths use
      -- ^ Output build directory structure.

      --

      -- NB: this will be bottom in the case that we are outputing

      -- a shell script that uses variables.

    }

-- | The directory structure relevant to executing a build plan.

type BuildPaths :: PathUsability -> Type
data family BuildPaths use
data instance BuildPaths Raw
  = RawBuildPaths
    { BuildPaths 'Raw -> String
rawDestDir :: !FilePath
      -- ^ Raw output build @destdir@ (might be relative).

    , BuildPaths 'Raw -> String
rawPrefix  :: !FilePath
      -- ^ Raw output build @prefix@ (might be relative).

    }
data instance BuildPaths ForPrep
  = BuildPathsForPrep
    { BuildPaths 'ForPrep -> Compiler
compilerForPrep :: !Compiler
      -- ^ Which @ghc@ and @ghc-pkg@ to use.

    , BuildPaths 'ForPrep -> String
installDir      :: !FilePath
      -- ^ Output installation directory @destdir/prefix@ (absolute).

    }
data instance BuildPaths ForBuild
  = BuildPaths
    { BuildPaths 'ForBuild -> Compiler
compiler   :: !Compiler
      -- ^ Which @ghc@ and @ghc-pkg@ to use.

    , BuildPaths 'ForBuild -> String
destDir    :: !FilePath
      -- ^ Output build @destdir@ (absolute).

    , BuildPaths 'ForBuild -> String
prefix     :: !FilePath
      -- ^ Output build @prefix@ (absolute).

    , BuildPaths 'ForBuild -> String
installDir :: !FilePath
      -- ^ Output installation directory @destdir/prefix@ (absolute).

    , BuildPaths 'ForBuild -> String
logDir     :: !FilePath
      -- ^ Directory in which to put logs.

    }

-- | The appropriate stage at which to use a filepath.

data PathUsability
  -- | We have just parsed filepaths. They need to be canonicalised

  -- before they can be used.

  = Raw
  -- | The filepaths have been canonicalised.

  --

  -- They are now suitable for preparatory build instructions,

  -- but not for performing the build.

  | ForPrep
  -- | The paths are suitable for performing the build.

  | ForBuild

-- | Canonicalise raw 'Paths', computing the appropriate directory structure

-- for preparing and executing a build, respectively.

canonicalizePaths :: Compiler
                  -> BuildStrategy
                  -> Paths Raw
                  -> IO ( Paths ForPrep, Paths ForBuild )
canonicalizePaths :: Compiler
-> BuildStrategy
-> Paths 'Raw
-> IO (Paths 'ForPrep, Paths 'ForBuild)
canonicalizePaths Compiler
compiler BuildStrategy
buildStrat
  ( Paths
    { $sel:fetchDir:Paths :: forall (use :: PathUsability). Paths use -> String
fetchDir   = String
fetchDir0
    , $sel:buildPaths:Paths :: forall (use :: PathUsability). Paths use -> BuildPaths use
buildPaths = RawBuildPaths { String
rawPrefix :: String
$sel:rawPrefix:RawBuildPaths :: BuildPaths 'Raw -> String
rawPrefix, String
rawDestDir :: String
$sel:rawDestDir:RawBuildPaths :: BuildPaths 'Raw -> String
rawDestDir } } )
  = do
      String
fetchDir   <- String -> IO String
canonicalizePath String
fetchDir0
      String
prefix     <- String -> IO String
canonicalizePath String
rawPrefix
      String
destDir    <- String -> IO String
canonicalizePath String
rawDestDir
      String
installDir <- String -> IO String
canonicalizePath ( String
rawDestDir String -> ShowS
</> ShowS
dropDrive String
prefix )
        -- We must use dropDrive here. Quoting from the documentation of (</>):

        --

        --   If the second path starts with a path separator or a drive letter,

        --   then (</>) returns the second path.

        --

        -- We don't want that, as we *do* want to concatenate both paths.


      String
logDir <- case BuildStrategy
buildStrat of
        Script  {} -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"${LOGDIR}" -- LOGDIR is defined by the script.

        Execute {} -> do
          -- Pick the logging directory based on the current time.

          UTCTime
time <- IO UTCTime
getCurrentTime
          let logDir :: String
logDir = String
"logs" String -> ShowS
</> forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%0Y-%m-%d_%H-%M-%S" UTCTime
time
          String -> IO String
canonicalizePath String
logDir

      let forBuild :: Paths 'ForBuild
forBuild = case BuildStrategy
buildStrat of
            Script { Bool
useVariables :: Bool
$sel:useVariables:Execute :: BuildStrategy -> Bool
useVariables }
              | Bool
useVariables
              -> Paths { $sel:fetchDir:Paths :: String
fetchDir   = String
"${SOURCES}"
                       , $sel:buildPaths:Paths :: BuildPaths 'ForBuild
buildPaths =
                         BuildPaths
                           { $sel:prefix:BuildPaths :: String
prefix     = String
"${PREFIX}"
                           , $sel:destDir:BuildPaths :: String
destDir    = String
"${DESTDIR}"
                           , $sel:installDir:BuildPaths :: String
installDir = String
"${DESTDIR}" String -> ShowS
</> String
"${PREFIX}"
                           , String
logDir :: String
$sel:logDir:BuildPaths :: String
logDir
                           , $sel:compiler:BuildPaths :: Compiler
compiler =
                             Compiler { $sel:ghcPath:Compiler :: String
ghcPath    = String
"${GHC}"
                                      , $sel:ghcPkgPath:Compiler :: String
ghcPkgPath = String
"${GHCPKG}" } } }
            BuildStrategy
_don'tUseVars ->
              Paths { String
fetchDir :: String
$sel:fetchDir:Paths :: String
fetchDir
                    , $sel:buildPaths:Paths :: BuildPaths 'ForBuild
buildPaths =
                      BuildPaths { Compiler
compiler :: Compiler
$sel:compiler:BuildPaths :: Compiler
compiler, String
destDir :: String
$sel:destDir:BuildPaths :: String
destDir, String
prefix :: String
$sel:prefix:BuildPaths :: String
prefix, String
installDir :: String
$sel:installDir:BuildPaths :: String
installDir, String
logDir :: String
$sel:logDir:BuildPaths :: String
logDir } }
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        ( Paths { String
fetchDir :: String
$sel:fetchDir:Paths :: String
fetchDir
                , $sel:buildPaths:Paths :: BuildPaths 'ForPrep
buildPaths =
                  BuildPathsForPrep { $sel:compilerForPrep:BuildPathsForPrep :: Compiler
compilerForPrep = Compiler
compiler, String
installDir :: String
$sel:installDir:BuildPathsForPrep :: String
installDir } }
        , Paths 'ForBuild
forBuild )

-- | How to handle deletion of temporary directories.

data TempDirPermanence
  = DeleteTempDirs
  | Don'tDeleteTempDirs
  deriving stock Int -> TempDirPermanence -> ShowS
[TempDirPermanence] -> ShowS
TempDirPermanence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TempDirPermanence] -> ShowS
$cshowList :: [TempDirPermanence] -> ShowS
show :: TempDirPermanence -> String
$cshow :: TempDirPermanence -> String
showsPrec :: Int -> TempDirPermanence -> ShowS
$cshowsPrec :: Int -> TempDirPermanence -> ShowS
Show

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

-- Verbosity


-- | Verbosity level for the @build-env@ package.

--

-- The default verbosity level is 'Normal' (1).

newtype Verbosity = Verbosity Int
  deriving newtype (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, Eq Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
Ord, Integer -> Verbosity
Verbosity -> Verbosity
Verbosity -> Verbosity -> Verbosity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Verbosity
$cfromInteger :: Integer -> Verbosity
signum :: Verbosity -> Verbosity
$csignum :: Verbosity -> Verbosity
abs :: Verbosity -> Verbosity
$cabs :: Verbosity -> Verbosity
negate :: Verbosity -> Verbosity
$cnegate :: Verbosity -> Verbosity
* :: Verbosity -> Verbosity -> Verbosity
$c* :: Verbosity -> Verbosity -> Verbosity
- :: Verbosity -> Verbosity -> Verbosity
$c- :: Verbosity -> Verbosity -> Verbosity
+ :: Verbosity -> Verbosity -> Verbosity
$c+ :: Verbosity -> Verbosity -> Verbosity
Num)
  deriving stock   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

-- | Get the flag corresponding to a verbosity, e.g. @-v2@.

verbosityFlag :: Verbosity -> String
verbosityFlag :: Verbosity -> String
verbosityFlag ( Verbosity Int
i )
  | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0
  = String
"-v0"
  | Bool
otherwise
  = String
"-v" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i

pattern Quiet, Normal, Verbose, Debug :: Verbosity
pattern $bQuiet :: Verbosity
$mQuiet :: forall {r}. Verbosity -> ((# #) -> r) -> ((# #) -> r) -> r
Quiet   = Verbosity 0
pattern $bNormal :: Verbosity
$mNormal :: forall {r}. Verbosity -> ((# #) -> r) -> ((# #) -> r) -> r
Normal  = Verbosity 1
pattern $bVerbose :: Verbosity
$mVerbose :: forall {r}. Verbosity -> ((# #) -> r) -> ((# #) -> r) -> r
Verbose = Verbosity 2
pattern $bDebug :: Verbosity
$mDebug :: forall {r}. Verbosity -> ((# #) -> r) -> ((# #) -> r) -> r
Debug   = Verbosity 3

quietMsg, normalMsg, verboseMsg, debugMsg :: Verbosity -> Text -> IO ()
quietMsg :: Verbosity -> Text -> IO ()
quietMsg   Verbosity
v Text
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v forall a. Ord a => a -> a -> Bool
>= Verbosity
Quiet  ) forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putMsg Text
msg
normalMsg :: Verbosity -> Text -> IO ()
normalMsg  Verbosity
v Text
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v forall a. Ord a => a -> a -> Bool
>= Verbosity
Normal ) forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putMsg Text
msg
verboseMsg :: Verbosity -> Text -> IO ()
verboseMsg Verbosity
v Text
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v forall a. Ord a => a -> a -> Bool
>= Verbosity
Verbose) forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putMsg Text
msg
debugMsg :: Verbosity -> Text -> IO ()
debugMsg   Verbosity
v Text
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v forall a. Ord a => a -> a -> Bool
>= Verbosity
Debug  ) forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putMsg Text
msg

-- | Write the text to @stdout@, and flush.

putMsg :: Text -> IO ()
putMsg :: Text -> IO ()
putMsg Text
msg = do
  Text -> IO ()
Text.putStrLn Text
msg
  Handle -> IO ()
hFlush Handle
stdout

ghcVerbosity, ghcPkgVerbosity, cabalVerbosity, setupVerbosity
  :: Verbosity -> String
ghcVerbosity :: Verbosity -> String
ghcVerbosity    = Verbosity -> String
verbosityFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Verbosity
maxGhcVerbosity    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Verbosity
1
ghcPkgVerbosity :: Verbosity -> String
ghcPkgVerbosity = Verbosity -> String
verbosityFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Verbosity
maxGhcPkgVerbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Verbosity
1
cabalVerbosity :: Verbosity -> String
cabalVerbosity  = Verbosity -> String
verbosityFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Verbosity
maxCabalVerbosity  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Verbosity
1
setupVerbosity :: Verbosity -> String
setupVerbosity  = Verbosity -> String
verbosityFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Verbosity
maxSetupVerbosity  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Verbosity
1

maxGhcVerbosity, maxGhcPkgVerbosity, maxCabalVerbosity, maxSetupVerbosity
  :: Verbosity
maxGhcVerbosity :: Verbosity
maxGhcVerbosity    = Int -> Verbosity
Verbosity Int
3
maxGhcPkgVerbosity :: Verbosity
maxGhcPkgVerbosity = Int -> Verbosity
Verbosity Int
2
maxCabalVerbosity :: Verbosity
maxCabalVerbosity  = Int -> Verbosity
Verbosity Int
3
maxSetupVerbosity :: Verbosity
maxSetupVerbosity  = Verbosity
maxCabalVerbosity

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

-- Reporting progress.


-- | A counter to measure progress, as units are compiled.

data Counter =
  Counter
    { Counter -> IORef Word
counterRef  :: !( IORef Word )
      -- ^ The running count.

    , Counter -> Word
counterMax :: !Word
      -- ^ The maximum that we're counting up to.

    }

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

-- Posix/Windows style differences.


-- | Whether to use Posix or Windows style:

--

--  - for executables, @./prog@ vs @prog.exe@,

--  - for the path separator, @:@ vs @;@.

data Style
  = PosixStyle
  | WinStyle

-- | OS-dependent separator for the PATH environment variable.

pATHSeparator :: Style -> String
pATHSeparator :: Style -> String
pATHSeparator Style
PosixStyle = String
":"
pATHSeparator Style
WinStyle   = String
";"

-- | The style associated with the OS the program is currently running on.

hostStyle :: Style
hostStyle :: Style
hostStyle =
#if defined(mingw32_HOST_OS)
  WinStyle
#else
  Style
PosixStyle
#endif