ats-pkg-3.0.0.4: internal/Quaalude.cpphs

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}

module Quaalude ( hex
                , bool
                , intersperse
                , transpose
                , sortBy
                , void
                , unless
                , when
                , join
                , fold
                , zipWithM_
                , zipWithM
                , filterM
                , encode
                , decode
                , fromMaybe
                , isPrefixOf
                , isSuffixOf
                , on
                , both
                , (***)
                , (&&&)
                , (<=<)
                , ($>)
                , first
                , second
                , getEnv
                , exitWith
                , showVersion
                , traverse_
                , nubSpecial
                , ExitCode (ExitSuccess)
                , MonadIO (..)
                -- * Miscellaneous
                , makeExe
                -- * "System.Process.Ext" reëxports
                , silentCreateProcess
                -- * "Data.Text.Lazy" reëxports
                , Text
                , pack
                , unpack
                -- * "Control.Composition" reëxports
                , biaxe
                , (.*)
                , (.**)
                , thread
                -- * Dhall reëxports
                , Interpret
                , Inject
                , Generic
                , Binary
                , input
                , auto
                , detailed
                -- * Shake reëxports
                , Rules
                , Action
                , command
                , command_
                , (%>)
                , need
                , want
                , shake
                , Rebuild (..)
                , (~>)
                , cmd
                , cmd_
                , ShakeOptions (..)
                , shakeOptions
                , copyFile'
                , Change (..)
                , Verbosity (..)
                , removeFilesAfter
                , Lint (..)
                , takeBaseName
                , takeFileName
                , takeDirectory
                , (-<.>)
                , makeExecutable
                -- * "Network.HTTP.Client.TLS" reëxports
                , tlsManagerSettings
                -- "Network.HTTP.Client" reëxports
                , newManager
                , parseRequest
                , httpLbs
                , Response (..)
                , Request (method, redirectCount)
                -- * "System.FilePath" reëxports
                , (</>)
                , pathSeparator
                -- * ByteString reëxports
                , ByteString
                -- * Helpers for pretty-printing
                , (<#>)
                -- * "Text.PrettyPrint.ANSI.Leijen" reëxports
                , (<+>)
                , text
                , punctuate
                , dullred
                , linebreak
                , dullyellow
                , hardline
                , hang
                , indent
                , putDoc
                , Pretty (pretty)
                , module X
                -- Lens exports
                , Lens'
                , over
                , _Just
                , view
                , _1
                , _2
                , _4
                , each
                , (&)
                , (%~)

#ifdef DEBUG
                , traceShowId
                , traceShow
#endif
                ) where

import           Control.Arrow                hiding ((<+>))
import           Control.Composition
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.State.Lazy
import           Data.Binary
import           Data.Bool                    (bool)
import           Data.ByteString.Lazy         (ByteString)
import           Data.Foldable                (fold, traverse_)
import           Data.Functor                 (($>))
import           Data.List
import           Data.Maybe                   (fromMaybe)
import           Data.Text.Lazy               (Text, pack, unpack)
import           Data.Version                 (showVersion)
#ifdef DEBUG
import           Debug.Trace                  (traceShow, traceShowId)
#endif
import           Development.Shake            hiding (getEnv)
import           Development.Shake.FilePath
import           Dhall                        hiding (Text, bool)
import           Lens.Micro                   hiding (both)
import           Lens.Micro.Extras
import           Network.HTTP.Client
import           Network.HTTP.Client.TLS      (tlsManagerSettings)
import           Numeric                      (showHex)
import           System.Directory             as X
import           System.Environment           (getEnv)
import           System.Exit                  (ExitCode (ExitSuccess), exitWith)
import           System.Info                  (os)
#ifndef mingw32_HOST_OS
import           System.Posix.Files
#endif
import           System.Process               as X
import           System.Process.Ext
import           Text.PrettyPrint.ANSI.Leijen hiding (bool, group, (<$>), (</>), (<>))

infixr 5 <#>

#ifdef mingw32_HOST_OS
makeExecutable :: FilePath -> IO ()
makeExecutable = pure mempty
#else
makeExecutable :: FilePath -> IO ()
makeExecutable = flip setFileMode ownerModes
#endif

nubSpecial :: (Ord a) => [[a]] -> [[a]]
nubSpecial = pure . rmDups . join
    where rmDups = fmap head . group . sort

makeExe :: String
makeExe = case os of
    "freebsd"   -> "gmake"
    "openbsd"   -> "gmake"
    "netbsd"    -> "gmake"
    "solaris"   -> "gmake"
    "dragonfly" -> "gmake"
    _           -> "make"

hex :: Int -> String
hex = flip showHex mempty

instance Semigroup a => Semigroup (Action a) where
    (<>) a b = (<>) <$> a <*> b

instance (Semigroup a, Monoid a) => Monoid (Action a) where
    mempty = pure mempty
    mappend = (<>)

-- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the
-- prelude.
(<#>) :: Doc -> Doc -> Doc
(<#>) a b = a <> line <> b