-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-- | Shakefile for seq and associated binaries.
module Shake.Shakefile (main) where
import qualified Control.DeepSeq as DeepSeq
import           Control.Monad.Trans (liftIO)
import qualified Data.Binary as Binary
import qualified Data.Char as Char
import qualified Data.Either as Either
import qualified Data.Hashable as Hashable
import qualified Data.List as List
import qualified Data.Map as Map
import           Data.Map (Map)
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Typeable as Typeable

import qualified Development.Shake as Shake
import           Development.Shake (need, (%>), (&?>), (?==), (?>))
import qualified System.Console.Concurrent as Concurrent
import qualified System.Console.Regions as Regions
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.FilePath as FilePath
import           System.FilePath ((</>))
import qualified System.IO as IO
import qualified System.IO.Error as IO.Error
import qualified System.Posix as Posix
import qualified System.Process as Process

import qualified Text.Read as Read

import qualified Util.Exceptions as Exceptions
import qualified Util.Lists as Lists
import qualified Util.PPrint as PPrint
import qualified Util.SourceControl as SourceControl

import           Local.ShakeConfig (localConfig)
import qualified Shake.C as C
import qualified Shake.CcDeps as CcDeps
import qualified Shake.Config as Config
import qualified Shake.HsDeps as HsDeps
import qualified Shake.Progress as Progress
import qualified Shake.Util as Util

import           Control.Monad


-- * config

-- ** packages

-- | Package, with or without version e.g. containers-0.5.5.1
type Package = String

-- NOTE:
-- Remember to run tools/freeze_deps.hs after changing any of these.

-- | This is used to create karya.cabal and supply -package arguments to ghc.
basicPackages :: [(Package, String)]
basicPackages :: [([Char], [Char])]
basicPackages = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    -- really basic deps
    [ [([Char]
"base", [Char]
">=4.6"), ([Char]
"containers", [Char]
">=0.5")]
    , [Char] -> [([Char], [Char])]
w [Char]
"directory filepath process bytestring time unix array"
    , [Char] -> [([Char], [Char])]
w [Char]
"ghc-prim primitive"
    --  basic
    , [Char] -> [([Char], [Char])]
w [Char]
"deepseq data-ordlist cereal random stm network"
    , [([Char]
"text", [Char]
">=2")] -- force utf8 version
    , [([Char]
"extra", [Char]
">=1.3")]
    , [([Char]
"exceptions", [Char]
"")] -- only ghc 9
    , [Char] -> [([Char], [Char])]
w [Char]
"unordered-containers"
    , [([Char]
"transformers", [Char]
">=0.5.6.0"), ([Char]
"mtl", [Char]
">=2.2.1")]
    , [Char] -> [([Char], [Char])]
w [Char]
"vector utf8-string"
    , [Char] -> [([Char], [Char])]
w [Char]
"c-storable"
    -- shakefile
    , [([Char]
"shake", [Char]
">=0.16")]
    , [Char] -> [([Char], [Char])]
w [Char]
"binary hashable concurrent-output"
    -- Util
    , [([Char]
"Diff", [Char]
">=0.4")] -- Util.Test
    , [Char] -> [([Char], [Char])]
w [Char]
"QuickCheck" -- Util.Test
    , [([Char]
"pcre-light", [Char]
">=0.4"), ([Char]
"pcre-heavy", [Char]
">=0.2")] -- Util.Regex
    , [Char] -> [([Char], [Char])]
w [Char]
"ansi-terminal colour" -- Util.StyledText
    , [Char] -> [([Char], [Char])]
w [Char]
"async" -- Util.Processes
    , [Char] -> [([Char], [Char])]
w [Char]
"dlist" -- Util.TimeVector
    , [Char] -> [([Char], [Char])]
w [Char]
"hedgehog" -- Util.Test
    , [Char] -> [([Char], [Char])]
w [Char]
"pretty haskell-src" -- Util.PPrint
    , [Char] -> [([Char], [Char])]
w [Char]
"streaming"
    , [Char] -> [([Char], [Char])]
w [Char]
"wcwidth" -- Util.Format
    , [Char] -> [([Char], [Char])]
w [Char]
"zlib" -- Util.Files
    -- karya
    , [Char] -> [([Char], [Char])]
w [Char]
"attoparsec" -- Derive: tracklang parsing
    , [Char] -> [([Char], [Char])]
w [Char]
"old-locale"
    , [Char] -> [([Char], [Char])]
w [Char]
"hlibgit2"
    , [([Char]
"fclabels", [Char]
">=2")]
    , [Char] -> [([Char], [Char])]
w [Char]
"ghc ghc-paths haskeline terminfo" -- REPL
    -- Derive: score randomization
    , [Char] -> [([Char], [Char])]
w [Char]
"mersenne-random-pure64 random-shuffle"
    -- Has better errors that attoparsec.  TODO: try replacing attoparsec with
    -- this, see if it's fast enough.
    , [Char] -> [([Char], [Char])]
w [Char]
"megaparsec parser-combinators"
    , [([Char]
"zmidi-core", [Char]
">=0.6")] -- for Cmd.Load.Midi
    , [([Char]
"aeson", [Char]
">=1.1.0.0")] -- serialize and unserialize log msgs
    , [Char] -> [([Char], [Char])]
w [Char]
"med-module" -- for Cmd.Load.Med
    , [Char] -> [([Char], [Char])]
w [Char]
"base64-bytestring" -- for hashes in incremental rendering

    -- im, packages needed only for targets in Synth.
    , [Char] -> [([Char], [Char])]
w [Char]
"hsndfile hsndfile-vector"
    , [Char] -> [([Char], [Char])]
w [Char]
"cryptohash-md5" -- Synth.Shared.Note.hash
    , [Char] -> [([Char], [Char])]
w [Char]
"resourcet"
    , [Char] -> [([Char], [Char])]
w [Char]
"bindings-portaudio"
    , [Char] -> [([Char], [Char])]
w [Char]
"vivid-osc vivid-supercollider" -- Perform.Sc
    -- used only by App.ConvertEventLog
    , [([Char]
"ghc-events", [Char]
">=0.15")]
    ]
    where w :: [Char] -> [([Char], [Char])]
w = forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
p -> ([Char]
p, [Char]
"")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words

-- | These get emitted in the generated karya.cabal as optional sections.
optionalPackages :: Map String [(Package, String)]
optionalPackages :: Map [Char] [([Char], [Char])]
optionalPackages = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    -- criterion has many deps, and only needed by criterion benchmarks
    [ ([Char]
"criterion", [([Char]
"criterion", [Char]
"")])
    -- ekg also has many deps
    , ([Char]
"ekg", [([Char], [Char])]
ekgPackages)
    -- These are used in the Ness.* hierarchy, which probably only I use, and
    -- only from ghci, so I can omit the deps from common use.
    , ([Char]
"ness", [Char] -> [([Char], [Char])]
w [Char]
"conduit-audio conduit-audio-sndfile conduit-audio-samplerate")
    ]
    where w :: [Char] -> [([Char], [Char])]
w = forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
p -> ([Char]
p, [Char]
"")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words

enabledPackages :: [Package]
enabledPackages :: [[Char]]
enabledPackages = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [([Char], [Char])]
basicPackages
    , if Config -> Bool
Config.enableEkg Config
localConfig then [([Char], [Char])]
ekgPackages else []
    ]

-- | Packages supplied by tools/nix-enter.  These are also used by the CI
-- build.
nixPackages :: [Package]
nixPackages :: [[Char]]
nixPackages = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [([Char], [Char])]
basicPackages
    -- , get "criterion"
    ]
    -- where
    -- get p = Map.findWithDefault [] p optionalPackages

ekgPackages :: [(Package, String)]
ekgPackages :: [([Char], [Char])]
ekgPackages = [([Char]
"ekg", [Char]
"")]

-- * config implementation

ghcBinary :: FilePath
ghcBinary :: [Char]
ghcBinary = [Char]
"ghc"

build :: FilePath
build :: [Char]
build = [Char]
"build"

options :: [String] -> Shake.ShakeOptions
options :: [[Char]] -> ShakeOptions
options [[Char]]
args = ShakeOptions
Shake.shakeOptions
    { shakeFiles :: [Char]
Shake.shakeFiles = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"shake"
    -- I have my own concurrent output, which shake will mess up if it prints
    -- its own output.  Unfortunately this also suppresses the --version flag,
    -- and some other less useful ones.
    , shakeVerbosity :: Verbosity
Shake.shakeVerbosity = if Bool
version then Verbosity
Shake.Info else Verbosity
Shake.Warn
    , shakeReport :: [[Char]]
Shake.shakeReport = [[Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"report.html"]
    , shakeProgress :: IO Progress -> IO ()
Shake.shakeProgress =
        if Bool
verbose then forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()) else IO Progress -> IO ()
Progress.report
    -- Git branch checkouts change file timestamps, but not contents.
    -- But ghci only understands timestamp changes, not contents.
    -- TODO: I heard that 9.4 will fix this
    , shakeChange :: Change
Shake.shakeChange = Change
Shake.ChangeModtime
    }
    where
    -- This is stupid, but shake only lets me set options before parsing flags,
    -- and I only know the verbosity after parsing flags.
    verbose :: Bool
verbose = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char]
"-V" `List.isPrefixOf`) [[Char]]
args Bool -> Bool -> Bool
|| [Char]
"--verbose" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
args
    -- TODO -V for verbose always surprises me, I'd flip V and v... but I don't
    -- think shake lets me.  Meanwhile, I was so often confused by -v not
    -- emitting anything I'd go and do a bunch of debugging before I realized
    -- -v is version, not verbose.
    version :: Bool
version = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char]
"-v" `List.isPrefixOf`) [[Char]]
args Bool -> Bool -> Bool
|| [Char]
"--version" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
args

data Config = Config {
    Config -> Mode
buildMode :: Mode
    , Config -> [Char]
hscDir :: FilePath
    , Config -> [Char]
chsDir :: FilePath
    , Config -> [Char]
ghcLib :: FilePath
    , Config -> [Char]
fltkVersion :: String
    , Config -> MidiConfig
midiConfig :: MidiConfig
    , Config -> CLibs
cLibs :: CLibs
    , Config -> Flags
configFlags :: Flags
    -- | GHC version as returned by 'parseGhcVersion'.
    , Config -> (Int, Int, Int)
ghcVersion :: (Int, Int, Int)
    , Config -> [Char]
ccVersion :: String
    -- | Absolute path to the root directory for the project.
    , Config -> [Char]
rootDir :: FilePath
    } deriving (Int -> Config -> [Char] -> [Char]
[Config] -> [Char] -> [Char]
Config -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Config] -> [Char] -> [Char]
$cshowList :: [Config] -> [Char] -> [Char]
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> [Char] -> [Char]
$cshowsPrec :: Int -> Config -> [Char] -> [Char]
Show)

data CLibs = CLibs {
    CLibs -> ExternalLibrary
_libfltk :: C.ExternalLibrary
    } deriving (Int -> CLibs -> [Char] -> [Char]
[CLibs] -> [Char] -> [Char]
CLibs -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [CLibs] -> [Char] -> [Char]
$cshowList :: [CLibs] -> [Char] -> [Char]
show :: CLibs -> [Char]
$cshow :: CLibs -> [Char]
showsPrec :: Int -> CLibs -> [Char] -> [Char]
$cshowsPrec :: Int -> CLibs -> [Char] -> [Char]
Show)

buildDir :: Config -> FilePath
buildDir :: Config -> [Char]
buildDir = Mode -> [Char]
modeToDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Mode
buildMode

-- | Root of .o and .hi hierarchy.
oDir :: Config -> FilePath
oDir :: Config -> [Char]
oDir = ([Char] -> [Char] -> [Char]
</> [Char]
"obj") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [Char]
buildDir

-- | Root for generated documentation.
buildDocDir :: FilePath
buildDocDir :: [Char]
buildDocDir = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"doc"

-- | Root for documentation source.
docDir :: FilePath
docDir :: [Char]
docDir = [Char]
"doc"

cabalDir :: FilePath
cabalDir :: [Char]
cabalDir = [Char]
"doc/cabal"

-- * flags

type Flag = String

data Flags = Flags {
    -- | -D flags.  This is used by both c++ and ghc.
    Flags -> [[Char]]
define :: [Flag]
    -- | There's one global list of include dirs, for both haskell and C++.
    -- Technically they don't all need the same dirs, but it doesn't hurt to
    -- have unneeded ones.
    , Flags -> [[Char]]
cInclude :: [Flag]
    -- | Analogous to 'cInclude', this has -L flags, used when linking all
    -- C++ binaries.  TODO also use when linking hs?
    , Flags -> [[Char]]
cLibDirs :: [Flag]

    -- | Flags for c++.  This is the complete list and includes the 'define's
    -- and 'cInclude's.  This is global because all CcBinaries get these flags.
    , Flags -> [[Char]]
globalCcFlags :: [Flag]
    -- | Linker flags to link in whatever MIDI driver we are using today.
    -- There should be corresponding flags in 'define' to enable said driver.
    , Flags -> [[Char]]
midiLd :: [Flag]
    -- | GHC-specific flags.  Unlike 'globalCcFlags', this *isn't* the complete
    -- list.
    , Flags -> [[Char]]
hcFlags :: [Flag]
    -- | Flags needed when linking haskell.  Doesn't include the -packages.
    , Flags -> [[Char]]
hLinkFlags :: [Flag]
    -- | package db paths.
    , Flags -> [[Char]]
packageDbs :: [FilePath]
    , Flags -> [PackageId]
packageIds :: [Util.PackageId]
    } deriving (Int -> Flags -> [Char] -> [Char]
[Flags] -> [Char] -> [Char]
Flags -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Flags] -> [Char] -> [Char]
$cshowList :: [Flags] -> [Char] -> [Char]
show :: Flags -> [Char]
$cshow :: Flags -> [Char]
showsPrec :: Int -> Flags -> [Char] -> [Char]
$cshowsPrec :: Int -> Flags -> [Char] -> [Char]
Show)

-- TODO surely there is a GHC.Generic way to do this
instance Semigroup Flags where
    <> :: Flags -> Flags -> Flags
(<>)    (Flags [[Char]]
a1 [[Char]]
b1 [[Char]]
c1 [[Char]]
d1 [[Char]]
e1 [[Char]]
f1 [[Char]]
g1 [[Char]]
h1 [PackageId]
i1)
            (Flags [[Char]]
a2 [[Char]]
b2 [[Char]]
c2 [[Char]]
d2 [[Char]]
e2 [[Char]]
f2 [[Char]]
g2 [[Char]]
h2 [PackageId]
i2) =
        [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [PackageId]
-> Flags
Flags ([[Char]]
a1forall a. Semigroup a => a -> a -> a
<>[[Char]]
a2) ([[Char]]
b1forall a. Semigroup a => a -> a -> a
<>[[Char]]
b2) ([[Char]]
c1forall a. Semigroup a => a -> a -> a
<>[[Char]]
c2) ([[Char]]
d1forall a. Semigroup a => a -> a -> a
<>[[Char]]
d2) ([[Char]]
e1forall a. Semigroup a => a -> a -> a
<>[[Char]]
e2) ([[Char]]
f1forall a. Semigroup a => a -> a -> a
<>[[Char]]
f2) ([[Char]]
g1forall a. Semigroup a => a -> a -> a
<>[[Char]]
g2)
            ([[Char]]
h1forall a. Semigroup a => a -> a -> a
<>[[Char]]
h2) ([PackageId]
i1forall a. Semigroup a => a -> a -> a
<>[PackageId]
i2)

instance Monoid Flags where
    mempty :: Flags
mempty = [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [PackageId]
-> Flags
Flags [] [] [] [] [] [] [] [] []

-- | Like 'cInclude' except for things which do not wind up using cc, which
-- means that in a nix-shell they don't get the magic -I flags propagated via
-- env var, which means I have to do it myself.
cIncludeUnwrapped :: Flags -> IO [Flag]
cIncludeUnwrapped :: Flags -> IO [[Char]]
cIncludeUnwrapped Flags
flags =
    (Flags -> [[Char]]
cInclude Flags
flags <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-I"<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]]
parseNixIncludeFlags
    -- They are actually -isystem, which would go after -I and only work with
    -- #include <>.  I think I don't care though.

parseNixIncludeFlags :: IO [Flag]
parseNixIncludeFlags :: IO [[Char]]
parseNixIncludeFlags =
    forall a. Ord a => [a] -> [a]
Lists.uniqueSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall {a}. (Eq a, IsString a) => [a] -> [a]
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Char] -> IO (Maybe [Char])
Environment.lookupEnv [Char]
"NIX_CFLAGS_COMPILE"
    where
    extract :: [a] -> [a]
extract (a
"-isystem" : a
path : [a]
ws) = a
path forall a. a -> [a] -> [a]
: [a] -> [a]
extract [a]
ws
    extract (a
_ : [a]
ws) = [a] -> [a]
extract [a]
ws
    extract [] = []

-- * binaries

-- This section has project specific hardcoded lists of files.

-- ** hs

{- | Describe a single haskell binary.  The dependencies are inferred by
    chasing imports.
-}
data HsBinary = HsBinary {
    HsBinary -> [Char]
hsName :: FilePath
    , HsBinary -> [Char]
hsMain :: FilePath -- ^ main module
    , HsBinary -> [[Char]]
hsDeps :: [FilePath] -- ^ additional deps, relative to obj dir
    , HsBinary -> GuiType
hsGui :: GuiType
    , HsBinary -> [[Char]]
hsRtsFlags :: [Flag]
    } deriving (Int -> HsBinary -> [Char] -> [Char]
[HsBinary] -> [Char] -> [Char]
HsBinary -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [HsBinary] -> [Char] -> [Char]
$cshowList :: [HsBinary] -> [Char] -> [Char]
show :: HsBinary -> [Char]
$cshow :: HsBinary -> [Char]
showsPrec :: Int -> HsBinary -> [Char] -> [Char]
$cshowsPrec :: Int -> HsBinary -> [Char] -> [Char]
Show)

-- | RTS flags for generated binaries without an explicit target in
-- 'hsBinaries', like tests and profiles.
defaultRtsFlags :: [Flag]
defaultRtsFlags :: [[Char]]
defaultRtsFlags = [[Char]
"-N", [Char]
"-T"]

-- | GUI apps require some postprocessing.
data GuiType =
    NoGui -- ^ plain app
    | MakeBundle -- ^ run make_bundle on mac
    | HasIcon -- ^ run make_bundle, and add an icon from build/name.icns
    deriving (Int -> GuiType -> [Char] -> [Char]
[GuiType] -> [Char] -> [Char]
GuiType -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [GuiType] -> [Char] -> [Char]
$cshowList :: [GuiType] -> [Char] -> [Char]
show :: GuiType -> [Char]
$cshow :: GuiType -> [Char]
showsPrec :: Int -> GuiType -> [Char] -> [Char]
$cshowsPrec :: Int -> GuiType -> [Char] -> [Char]
Show, GuiType -> GuiType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuiType -> GuiType -> Bool
$c/= :: GuiType -> GuiType -> Bool
== :: GuiType -> GuiType -> Bool
$c== :: GuiType -> GuiType -> Bool
Eq)

hsBinaries :: [HsBinary]
hsBinaries :: [HsBinary]
hsBinaries =
    [ [Char] -> [Char] -> [[Char]] -> HsBinary
gui [Char]
"browser" [Char]
"Instrument/Browser.hs" [[Char]
"Instrument/browser_ui.cc.o"]
    , [Char] -> [Char] -> HsBinary
plain [Char]
"import_query" [Char]
"Shake/ImportQueryMain.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"convert_event_log" [Char]
"App/ConvertEventLog.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"dump" [Char]
"App/Dump.hs"
    -- ExtractDoc wants the global keymap, which winds up importing cmds that
    -- directly call UI level functions.  Even though it doesn't call the
    -- cmds, they're packaged together with the keybindings, so I wind up
    -- having to link in all that stuff anyway.
    , ([Char] -> [Char] -> HsBinary
plain [Char]
"extract_doc" [Char]
"App/ExtractDoc.hs") { hsDeps :: [[Char]]
hsDeps = [[Char]
"fltk/fltk.a"] }
    , [Char] -> [Char] -> HsBinary
plain [Char]
"extract_korvais" [Char]
"Solkattu/ExtractKorvais.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"generate_run_tests" [Char]
"Util/Test/GenerateRunTests.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"im_gc" [Char]
"Synth/ImGcMain.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"linkify" [Char]
"Util/Linkify.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"logcat" [Char]
"LogView/LogCat.hs"
    , [Char] -> [Char] -> [[Char]] -> HsBinary
gui [Char]
"logview" [Char]
"LogView/LogView.hs" [[Char]
"LogView/logview_ui.cc.o"]
    , [Char] -> [Char] -> HsBinary
plain [Char]
"make_db" [Char]
"Instrument/MakeDb.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"mixdown" [Char]
"Synth/MixDown.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"ness-submit" [Char]
"Ness/Submit.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"pprint" [Char]
"App/PPrint.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"repl" [Char]
"App/Repl.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"resample" [Char]
"Util/Audio/ResampleMain.hs"
    , ([Char] -> [Char] -> [[Char]] -> HsBinary
gui [Char]
"seq" [Char]
"App/Main.hs" [[Char]
"fltk/fltk.a"])
        { hsRtsFlags :: [[Char]]
hsRtsFlags =
            [ [Char]
"-N"
            -- Increase generation 0 size.  Informal tests with
            -- verify_performance seem to show a significant speed up.
            , [Char]
"-A8m"
            -- Enable GC stats.  It's pretty cheap and is used by EKG,
            -- MemoryLeak_test, and LDebug.memory.
            , [Char]
"-T"
            ]
        }
    , [Char] -> [Char] -> HsBinary
plain [Char]
"send" [Char]
"App/Send.hs"
    , ([Char] -> [Char] -> HsBinary
plain [Char]
"shakefile" [Char]
"Shake/Shakefile.hs")
        -- Turn off idle gc, and parallel gc, as recommended by the shake docs.
        { hsRtsFlags :: [[Char]]
hsRtsFlags = [[Char]
"-N", [Char]
"-I0", [Char]
"-qg", [Char]
"-qb"] }
    , [Char] -> [Char] -> HsBinary
plain [Char]
"show_timers" [Char]
"LogView/ShowTimers.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"stream_audio" [Char]
"Synth/StreamAudioMain.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"test_midi" [Char]
"Midi/TestMidi.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"tscore" [Char]
"Derive/TScore/TScoreMain.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"update" [Char]
"App/Update.hs"
    , ([Char] -> [Char] -> HsBinary
plain [Char]
"verify_performance" [Char]
"App/VerifyPerformance.hs")
        { hsRtsFlags :: [[Char]]
hsRtsFlags = [[Char]
"-N", [Char]
"-A8m"] }
    -- im
    , [Char] -> [Char] -> HsBinary
plain [Char]
"sampler-im" [Char]
"Synth/Sampler/SamplerIm.hs"
    , [Char] -> [Char] -> HsBinary
plain [Char]
"faust-im" [Char]
"Synth/Faust/FaustIm.hs"
    ]
    where
    plain :: [Char] -> [Char] -> HsBinary
plain [Char]
name [Char]
main = HsBinary
        { hsName :: [Char]
hsName = [Char]
name
        , hsMain :: [Char]
hsMain = [Char]
main
        , hsDeps :: [[Char]]
hsDeps = []
        , hsGui :: GuiType
hsGui = GuiType
NoGui
        , hsRtsFlags :: [[Char]]
hsRtsFlags = [[Char]
"-N"]
        }
    gui :: [Char] -> [Char] -> [[Char]] -> HsBinary
gui [Char]
name [Char]
main [[Char]]
deps = HsBinary
        { hsName :: [Char]
hsName = [Char]
name
        , hsMain :: [Char]
hsMain = [Char]
main
        , hsDeps :: [[Char]]
hsDeps = [[Char]]
deps
        , hsGui :: GuiType
hsGui = GuiType
HasIcon
        , hsRtsFlags :: [[Char]]
hsRtsFlags = [[Char]
"-N"]
        }

runProfile :: FilePath
runProfile :: [Char]
runProfile = Mode -> [Char]
modeToDir Mode
Profile [Char] -> [Char] -> [Char]
</> [Char]
"RunProfile"

-- | This is run as a test, but must be compiled with optimization like
-- a profile.
runProfileTest :: FilePath
runProfileTest :: [Char]
runProfileTest = Mode -> [Char]
modeToDir Mode
Profile [Char] -> [Char] -> [Char]
</> [Char]
"RunProfile-Cmd.MemoryLeak"

runTests :: FilePath
runTests :: [Char]
runTests = Mode -> [Char]
modeToDir Mode
Test [Char] -> [Char] -> [Char]
</> [Char]
"RunTests"

-- | Hardcoded list of files that should be processed with CPP when chasing
-- deps.
cppFlags :: Config -> FilePath -> Maybe [String]
cppFlags :: Config -> [Char] -> Maybe [[Char]]
cppFlags Config
config [Char]
fn
    -- TODO: I think this cInclude should be cIncludeUnwrapped because it looks
    -- like nix cpphs isn't wrapped.  But I don't care about system headers for
    -- the purposes of recompilation, because I don't expect those to change.
    | [Char]
fn forall a. Ord a => a -> Set a -> Bool
`Set.member` Generated
cppInImports = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        Flags -> [[Char]]
cInclude (Config -> Flags
configFlags Config
config) forall a. [a] -> [a] -> [a]
++ Flags -> [[Char]]
define (Config -> Flags
configFlags Config
config)
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Hardcoded list of modules that use CPP to determine their imports.  This
-- means I need to CPP the file first before tracking the dependencies.
--
-- It would be more robust to always run CPP if the file includes
-- 'LANGUAGE .*CPP' but there aren't many modules with CPP in their import
-- lists so it should be faster to hardcode them.
--
-- TODO this is error-prone, maybe I should have a hack in HsDeps to look for
-- #include in the import block.
-- TODO this is also needed if I use #defines, but why don't I always chase
-- includes?
cppInImports :: Set.Set FilePath
cppInImports :: Generated
cppInImports = forall a. Ord a => [a] -> Set a
Set.fromList
    [ [Char]
"App/Main.hs"
    , [Char]
"Cmd/Repl.hs"
    , [Char]
"Midi/MidiDriver.hs"
    , [Char]
"App/LoadInstruments.hs"
    ]

-- | Generated src files.
generatedSrc :: HsDeps.Generated
generatedSrc :: Generated
generatedSrc = HsDeps.Generated
    { _generatedHs :: Generated
_generatedHs = forall a. Ord a => [a] -> Set a
Set.fromList [[Char]
generatedKorvais, [Char]
generatedFaustAll]
    , _generatedExtensions :: [[Char]]
_generatedExtensions = [[Char]
".hsc", [Char]
".chs"]
    }

-- | Module that define 'main' and should get linked to their own binaries,
-- and the names of their eventual binaries.
nameToMain :: Map FilePath FilePath
nameToMain :: Map [Char] [Char]
nameToMain = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(HsBinary -> [Char]
hsName HsBinary
b, HsBinary -> [Char]
hsMain HsBinary
b) | HsBinary
b <- [HsBinary]
hsBinaries]

-- | Haskell files that use the FFI have dependencies on C++ source.
-- I could figure this out automatically by looking for @foreign import ...@
-- and searching for a neighboring .cc file with those symbols, but it's
-- simpler to give the dependency explicitly.  TODO a somewhat more modular way
-- would be a magic comment that declares a dependency on a C file.
hsToCc :: Map FilePath [FilePath]
hsToCc :: Map [Char] [[Char]]
hsToCc = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
    [ ([Char]
"Midi/CoreMidi.hs", [[Char]
"Midi/core_midi.cc"])
    , ([Char]
"Midi/JackMidi.hsc", [[Char]
"Midi/jack.cc"])
    , ([Char]
"LogView/LogViewC.hsc", [[Char]
"LogView/interface.cc"])
    , ([Char]
"Instrument/BrowserC.hsc", [[Char]
"Instrument/interface.cc"])
    , ([Char]
"Util/Fltk.hs", [[Char]
"Util/fltk_interface.cc"])
    , ([Char]
"Synth/Faust/PatchC.hs", forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"Synth/Faust"</>) [[Char]
"patch_c.cc"])
    , ([Char]
"Util/VectorC.hs", [[Char]
"Util/vectorc.cc"])
    ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (, [[Char]
"Ui/c_interface.cc"]) [[Char]]
c_interface
    where
    c_interface :: [[Char]]
c_interface =
        [ [Char]
"Ui/BlockC.hsc", [Char]
"Ui/KeycapsC.hsc", [Char]
"Ui/RulerC.hsc", [Char]
"Ui/StyleC.hsc"
        , [Char]
"Ui/SymbolC.hsc", [Char]
"Ui/TrackC.hsc", [Char]
"Ui/UiMsgC.hsc"
        ]

criterionHsSuffix :: FilePath
criterionHsSuffix :: [Char]
criterionHsSuffix = [Char]
"_criterion.hs"

-- ** cc

ccDeps :: Config -> C.Binary config -> [FilePath]
ccDeps :: forall config. Config -> Binary config -> [[Char]]
ccDeps Config
config Binary config
binary = forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char]
oDir Config
config </>) (forall config. Binary config -> [[Char]]
C.binObjs Binary config
binary)

libsamplerate :: C.ExternalLibrary
libsamplerate :: ExternalLibrary
libsamplerate = Config -> ExternalLibrary
Config.libsamplerate Config
localConfig

libsndfile :: C.ExternalLibrary
libsndfile :: ExternalLibrary
libsndfile = [Char] -> ExternalLibrary
C.library [Char]
"sndfile"

-- I don't quite like this, because now everything is dependent on Config,
-- when I want minimal dependency.  Return strings with ${var} in them would
-- delay the dependency.
ccBinaries :: [C.Binary Config]
ccBinaries :: [Binary Config]
ccBinaries =
    [ ([Char] -> [[Char]] -> Binary Config
fltk [Char]
"test_block" [[Char]
"fltk/test_block.cc.o", [Char]
"fltk/fltk.a"])
        { binLibraries :: Config -> [ExternalLibrary]
C.binLibraries = \Config
c -> [ExternalLibrary
libsamplerate, Config -> ExternalLibrary
libfltk Config
c] }
    , [Char] -> [[Char]] -> Binary Config
fltk [Char]
"test_browser"
        [ [Char]
"Instrument/test_browser.cc.o", [Char]
"Instrument/browser_ui.cc.o"
        , [Char]
"fltk/f_util.cc.o"
        ]
    , [Char] -> [[Char]] -> Binary Config
fltk [Char]
"test_logview"
        [ [Char]
"LogView/test_logview.cc.o", [Char]
"LogView/logview_ui.cc.o"
        , [Char]
"fltk/f_util.cc.o"
        ]
    -- im
    , Binary Config
playCacheBinary
    , Binary Config
pannerBinary
    , forall config.
[Char] -> [Char] -> [ExternalLibrary] -> [[Char]] -> Binary config
makePlayCacheBinary [Char]
"test_play_cache" [Char]
"test_play_cache.cc" [ExternalLibrary
libsndfile] []
    ]
    where
    libfltk :: Config -> ExternalLibrary
libfltk = CLibs -> ExternalLibrary
_libfltk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> CLibs
cLibs
    fltk :: [Char] -> [[Char]] -> Binary Config
fltk [Char]
name [[Char]]
objs = (forall config. [Char] -> [[Char]] -> Binary config
C.binary [Char]
name [[Char]]
objs)
        { binLibraries :: Config -> [ExternalLibrary]
C.binLibraries = \Config
config -> [Config -> ExternalLibrary
libfltk Config
config]
        , binPostproc :: [Char] -> Action ()
C.binPostproc = Bool -> [Char] -> Action ()
makeBundle Bool
False
        }

-- TODO This compiles under linux, but I have no idea if it actually produces
-- a valid vst.
playCacheBinary :: C.Binary Config
playCacheBinary :: Binary Config
playCacheBinary =
    Binary Config -> Binary Config
addVstFlags forall a b. (a -> b) -> a -> b
$ forall config.
[Char] -> [Char] -> [ExternalLibrary] -> [[Char]] -> Binary config
makePlayCacheBinary [Char]
"play_cache" [Char]
"PlayCache.cc" [] []

pannerBinary :: C.Binary Config
pannerBinary :: Binary Config
pannerBinary = Binary Config -> Binary Config
addVstFlags forall a b. (a -> b) -> a -> b
$ forall config. [Char] -> [[Char]] -> Binary config
C.binary [Char]
"panner" [[Char]
"Synth/play_cache/Panner.cc.o"]

-- | Add all the gizmos to make a VST.
addVstFlags :: C.Binary Config -> C.Binary Config
addVstFlags :: Binary Config -> Binary Config
addVstFlags Binary Config
binary = Binary Config
binary
    { binName :: [Char]
C.binName = forall config. Binary config -> [Char]
C.binName Binary Config
binary forall a. Semigroup a => a -> a -> a
<> [Char]
soname
    , binObjs :: [[Char]]
C.binObjs = [Char]
"Synth/vst2/interface.cc.o" forall a. a -> [a] -> [a]
: forall config. Binary config -> [[Char]]
C.binObjs Binary Config
binary
    , binLink :: Config -> [[Char]]
C.binLink = \Config
c -> forall config. Binary config -> config -> [[Char]]
C.binLink Binary Config
binary Config
c forall a. [a] -> [a] -> [a]
++ case Platform
Util.platform of
        Platform
Util.Mac -> [[Char]
"-bundle"]
        Platform
Util.Linux -> [[Char]
"-shared", [Char]
"-Wl,-soname=" forall a. Semigroup a => a -> a -> a
<> [Char]
soname]
    , binCompile :: Config -> [[Char]]
C.binCompile = \Config
c -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall config. Binary config -> config -> [[Char]]
C.binCompile Binary Config
binary Config
c
        -- TODO I need config for VST_BASE_DIR
        -- that means I need to split out rootDir to a independent Config
        -- that could even be static, then I don't need an argument.
        , [[Char]
"-DVST_BASE_DIR=\"" forall a. Semigroup a => a -> a -> a
<> (Config -> [Char]
rootDir Config
c [Char] -> [Char] -> [Char]
</> [Char]
"im") forall a. Semigroup a => a -> a -> a
<> [Char]
"\""]
        , case Platform
Util.platform of
            Platform
Util.Mac -> []
            Platform
Util.Linux -> [[Char]
"-fPIC"]
        ]
    , binPostproc :: [Char] -> Action ()
C.binPostproc = \[Char]
fn -> do
        Bool -> BundleType -> Bool -> [Char] -> Action ()
makeBundle_ Bool
False BundleType
BNDL Bool
False [Char]
fn
        -- This is weird because the output is thing.vst, but I build with
        -- thing.  Really it should be thing.vst is built from thing via
        -- makeBundle, instead of this postproc thing.
        [Char] -> [[Char]] -> Action ()
Util.system [Char]
"touch" [[Char]
fn] -- else shake gets upset
    }
    where
    soname :: [Char]
soname = case Platform
Util.platform of
        Platform
Util.Mac -> [Char]
""
        Platform
Util.Linux -> [Char]
".so"

makePlayCacheBinary :: String -> FilePath -> [C.ExternalLibrary] -> [FilePath]
    -> C.Binary config
makePlayCacheBinary :: forall config.
[Char] -> [Char] -> [ExternalLibrary] -> [[Char]] -> Binary config
makePlayCacheBinary [Char]
name [Char]
main [ExternalLibrary]
libs [[Char]]
objs = (forall config. [Char] -> [[Char]] -> Binary config
C.binary [Char]
name [])
    { binObjs :: [[Char]]
C.binObjs = ([[Char]]
objs++) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"Synth/play_cache"</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++[Char]
".o")) forall a b. (a -> b) -> a -> b
$
        [ [Char]
main
        , [Char]
"Flac.cc"
        , [Char]
"Thru.cc", [Char]
"Resample.cc", [Char]
"SampleDirectory.cc", [Char]
"SampleFile.cc"
        , [Char]
"Streamer.cc", [Char]
"Tracks.cc"
        , [Char]
"Wav.cc"
        , [Char]
"ringbuffer.cc"
        ]
    , binLibraries :: config -> [ExternalLibrary]
C.binLibraries = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$
        [ case Platform
Util.platform of
            -- This is the system libsamplerate, not the hacked static one at
            -- 'libsamplerate'.  The reason is that linux doesn't like to put
            -- a .a lib in .so, it wants me to recompile with -fPIC.  In any
            -- case, play_cache doesn't need hacked libsamplerate.
            Platform
Util.Linux -> [Char] -> ExternalLibrary
C.library [Char]
"samplerate"
            -- Meanwhile OS X doesn't seem to care, so just use the same one.
            Platform
Util.Mac -> ExternalLibrary
libsamplerate
        , [Char] -> ExternalLibrary
C.library [Char]
"FLAC", [Char] -> ExternalLibrary
C.library [Char]
"FLAC++"
        ] forall a. [a] -> [a] -> [a]
++ [[Char] -> ExternalLibrary
C.library [Char]
"pthread" | Platform
Util.platform forall a. Eq a => a -> a -> Bool
== Platform
Util.Linux]
        forall a. [a] -> [a] -> [a]
++ [ExternalLibrary]
libs
    }


{- | Since fltk.a is a library, not a binary, I can't just chase includes to
    know all the source files.  I could read fltk/*.cc at runtime, but the fltk
    directory changes so rarely it seems not a great burden to just hardcode
    them all here.

    'ccORule' has a special hack to give these '_libfltk' flags, since I don't
    have a separate CcLibrary target.
-}
fltkDeps :: Config -> [FilePath]
fltkDeps :: Config -> [[Char]]
fltkDeps Config
config = forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char] -> [Char]
srcToObj Config
config forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"fltk"</>))
    [ [Char]
"Block.cc"
    , [Char]
"CachedScroll.cc"
    , [Char]
"Color.cc"
    , [Char]
"EventTrack.cc"
    , [Char]
"Keycaps.cc"
    , [Char]
"MoveTile.cc"
    , [Char]
"MsgCollector.cc"
    , [Char]
"PeakCache.cc"
    , [Char]
"RulerOverlay.cc"
    , [Char]
"RulerTrack.cc"
    , [Char]
"Scrollbar.cc"
    , [Char]
"Selection.cc"
    , [Char]
"SelectionOverlay.cc"
    , [Char]
"SimpleScroll.cc"
    , [Char]
"SkeletonDisplay.cc"
    , [Char]
"StyleTable.cc"
    , [Char]
"SymbolOutput.cc"
    , [Char]
"SymbolTable.cc"
    , [Char]
"Track.cc"
    , [Char]
"TrackTile.cc"
    , [Char]
"WrappedInput.cc"
    , [Char]
"alpha_draw.cc"
    , [Char]
"config.cc"
    , [Char]
"f_util.cc"
    , [Char]
"input_util.cc"
    , [Char]
"types.cc"
    , [Char]
"utf8.cc"
    , [Char]
"util.cc"
    ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char] -> [Char]
srcToObj Config
config)
    -- TODO this should be a separate library, but I can't be bothered while
    -- the shakefile is such a mess
    [ [Char]
"Synth/play_cache/Wav.cc"
    ]

-- * mode

data Mode = Debug | Opt | Test | Profile deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum, Int -> Mode -> [Char] -> [Char]
[Mode] -> [Char] -> [Char]
Mode -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Mode] -> [Char] -> [Char]
$cshowList :: [Mode] -> [Char] -> [Char]
show :: Mode -> [Char]
$cshow :: Mode -> [Char]
showsPrec :: Int -> Mode -> [Char] -> [Char]
$cshowsPrec :: Int -> Mode -> [Char] -> [Char]
Show)

allModes :: [Mode]
allModes :: [Mode]
allModes = [Mode
Debug .. Mode
Profile]

modeToDir :: Mode -> FilePath
modeToDir :: Mode -> [Char]
modeToDir Mode
mode = ([Char]
build </>) forall a b. (a -> b) -> a -> b
$ case Mode
mode of
    Mode
Debug -> [Char]
"debug"
    Mode
Opt -> [Char]
"opt"
    Mode
Test -> [Char]
"test"
    Mode
Profile -> [Char]
"profile"

targetToMode :: FilePath -> Maybe Mode
targetToMode :: [Char] -> Maybe Mode
targetToMode [Char]
target = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
target) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Mode -> [Char]
modeToDir [Mode
Debug ..]) [Mode
Debug ..])

data MidiConfig = StubMidi | JackMidi | CoreMidi deriving (Int -> MidiConfig -> [Char] -> [Char]
[MidiConfig] -> [Char] -> [Char]
MidiConfig -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [MidiConfig] -> [Char] -> [Char]
$cshowList :: [MidiConfig] -> [Char] -> [Char]
show :: MidiConfig -> [Char]
$cshow :: MidiConfig -> [Char]
showsPrec :: Int -> MidiConfig -> [Char] -> [Char]
$cshowsPrec :: Int -> MidiConfig -> [Char] -> [Char]
Show, MidiConfig -> MidiConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiConfig -> MidiConfig -> Bool
$c/= :: MidiConfig -> MidiConfig -> Bool
== :: MidiConfig -> MidiConfig -> Bool
$c== :: MidiConfig -> MidiConfig -> Bool
Eq)

ghcWarnings :: Config -> [String]
ghcWarnings :: Config -> [[Char]]
ghcWarnings Config
config = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [[Char]
"-W", [Char]
"-Wcompat"]
    -- pass -Wundef to CPP for warnings on #if TYPO
    , [[Char]
"-Wcpp-undef" | (Int, Int, Int)
ver forall a. Ord a => a -> a -> Bool
>= (Int
8, Int
2, Int
0)]
    , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-W"++) [[Char]]
warns
    , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-Wno-"++) [[Char]]
noWarns
    ]
    where
    ver :: (Int, Int, Int)
ver = Config -> (Int, Int, Int)
ghcVersion Config
config
    warns :: [[Char]]
warns =
        [ [Char]
"identities"
        , [Char]
"incomplete-record-updates"
        , [Char]
"missing-fields"
        -- Super noisy, I can't even write 'deriving (Show)' any more!
        -- , "missing-deriving-strategies"
        -- Check compatibility with
        -- https://ghc.haskell.org/trac/ghc/wiki/Proposal/MonadOfNoReturn
        , [Char]
"noncanonical-monad-instances"
        -- The 8.2.1 docs claim it's on by default, but it's not.
        , [Char]
"redundant-constraints"
        , [Char]
"tabs"
        , [Char]
"unused-matches"
        , [Char]
"wrong-do-bind"
        ] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Char]
"partial-fields" | (Int, Int, Int)
ver forall a. Ord a => a -> a -> Bool
>= (Int
8, Int
4, Int
0)]
        , [[Char]
"invalid-haddock" | (Int, Int, Int)
ver forall a. Ord a => a -> a -> Bool
>= (Int
9, Int
0, Int
0)]
        -- This has many false positives because it doesn't know what binary
        -- I'm building.
        -- , ["unused-packages" | ver >= (8, 10, 0)]
        ]
    noWarns :: [[Char]]
noWarns = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        -- This is just about ($xyz) for TemplateHaskell, which I don't use,
        -- and (%n) for linear, which I'm unlikely to use.
        [ [[Char]
"operator-whitespace-ext-conflict" | (Int, Int, Int)
ver forall a. Ord a => a -> a -> Bool
>= (Int
9, Int
2, Int
1)]
        -- TEST ifdefs can cause duplicate exports if they add X(..) to the
        -- X export.
        , [[Char]
"duplicate-exports" | Config -> Mode
buildMode Config
config forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mode
Test, Mode
Profile]]
        ]

configure :: IO (Mode -> Config)
configure :: IO (Mode -> Config)
configure = do
    [([Char], [Char])]
env <- IO [([Char], [Char])]
Environment.getEnvironment
    let midi :: MidiConfig
midi = [([Char], [Char])] -> MidiConfig
midiFromEnv [([Char], [Char])]
env
    ([Char]
fltkVersion, [[Char]]
fltkCs, [[Char]]
fltkLds) <-
        [Char] -> IO ([Char], [[Char]], [[Char]])
configureFltk (Config -> [Char]
Config.fltkConfig Config
localConfig)
    [Char]
ghcLib <- [Char] -> [[Char]] -> IO [Char]
run [Char]
ghcBinary [[Char]
"--print-libdir"]
    let ghcVersion :: (Int, Int, Int)
ghcVersion = [Char] -> (Int, Int, Int)
parseGhcVersion [Char]
ghcLib
    [Char]
ccVersion <- [Char] -> [[Char]] -> IO [Char]
run [Char]
"cc" [[Char]
"--version"]
    -- When configured for v2 cabal, then use this package db.
    -- cabal.project should have had it write .ghc.environment.
    Maybe ([[Char]], [PackageId])
packageDbIds <- if Config -> Bool
Config.useCabalV2 Config
localConfig
        then forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO [Char]
"useCabalV2=True but no .ghc.environment,\
                \ should have been created by cabal build --only-dep")
            (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe ([[Char]], [PackageId]))
Util.readGhcEnvironment
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    -- TODO this breaks if you run from a different directory
    [Char]
rootDir <- IO [Char]
Directory.getCurrentDirectory
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Mode
mode -> Config
        { buildMode :: Mode
buildMode = Mode
mode
        , hscDir :: [Char]
hscDir = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"hsc"
        , chsDir :: [Char]
chsDir = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"chs"
        , ghcLib :: [Char]
ghcLib = [Char]
ghcLib
        , fltkVersion :: [Char]
fltkVersion = [Char]
fltkVersion
        , midiConfig :: MidiConfig
midiConfig = MidiConfig
midi
        , cLibs :: CLibs
cLibs = CLibs
            { _libfltk :: ExternalLibrary
_libfltk = C.ExternalLibrary
                { libLink :: [[Char]]
libLink = [[Char]]
fltkLds
                , libCompile :: [[Char]]
libCompile = [[Char]]
fltkCs
                }
            }
        , configFlags :: Flags
configFlags = Mode -> Flags -> Flags
setGlobalCcFlags Mode
mode forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ Mode -> (Int, Int, Int) -> Maybe ([[Char]], [PackageId]) -> Flags
configFlags Mode
mode (Int, Int, Int)
ghcVersion Maybe ([[Char]], [PackageId])
packageDbIds
            , MidiConfig -> Flags
osFlags MidiConfig
midi
            ]
        , ghcVersion :: (Int, Int, Int)
ghcVersion = (Int, Int, Int)
ghcVersion
        , ccVersion :: [Char]
ccVersion = [Char]
ccVersion
        , rootDir :: [Char]
rootDir = [Char]
rootDir
        }
    where
    configFlags :: Mode -> (Int, Int, Int) -> Maybe ([[Char]], [PackageId]) -> Flags
configFlags Mode
mode (Int, Int, Int)
ghcVersion Maybe ([[Char]], [PackageId])
packageDbIds = forall a. Monoid a => a
mempty
        { define :: [[Char]]
define = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]
"-DTESTING" | Mode
mode forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mode
Test, Mode
Profile]]
            , [[Char]
"-DSTUB_OUT_FLTK" | Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Test]
            , [[Char]
"-DBUILD_DIR=\"" forall a. [a] -> [a] -> [a]
++ Mode -> [Char]
modeToDir Mode
mode forall a. [a] -> [a] -> [a]
++ [Char]
"\""]
            , [[Char]
"-DGHC_VERSION=" forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> [Char]
ghcVersionMacro (Int, Int, Int)
ghcVersion]
            , Config -> [[Char]]
Config.extraDefines Config
localConfig
            ]
        , cInclude :: [[Char]]
cInclude = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-I"<>) [[Char]
".", [Char]
"" forall a. [a] -> [a] -> [a]
++ Mode -> [Char]
modeToDir Mode
mode, [Char]
"fltk"]
            -- Put this first to make sure I don't see the system header.
            -- TODO this breaks the idea of modular libraries, but the haskell
            -- flags really have to be global, because any difference in CPP
            -- flags causes ghc to not want to load .o files.
            , ExternalLibrary -> [[Char]]
C.libCompile ExternalLibrary
libsamplerate
            , ExternalLibrary -> [[Char]]
C.libCompile (Config -> ExternalLibrary
Config.rubberband Config
localConfig)
            , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-I"<>) (Config -> [[Char]]
Config.globalIncludes Config
localConfig)
            ]
        , cLibDirs :: [[Char]]
cLibDirs = forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-L"<>) forall a b. (a -> b) -> a -> b
$ Config -> [[Char]]
Config.globalLibDirs Config
localConfig
        , hcFlags :: [[Char]]
hcFlags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            -- This is necessary for ghci loading to work in 7.8.
            -- Except for profiling, where it wants "p_dyn" libraries, which
            -- don't seem to exist.
            [ [[Char]
"-dynamic" | Mode
mode forall a. Eq a => a -> a -> Bool
/= Mode
Profile]
            , case Mode
mode of
                Mode
Debug -> []
                Mode
Opt -> [[Char]
"-O"]
                Mode
Test -> [[Char]
"-fhpc"]
                Mode
Profile -> [[Char]
"-O", [Char]
"-prof"]
                    -- I use manual SCCs for accuracy, but auto ones can be
                    -- useful to figure out where to put manual ones.
                    -- ++ ["-fprof-auto-top"]
                    -- ++ ["-fprof-auto-exported"]
            ]
        , hLinkFlags :: [[Char]]
hLinkFlags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]
"-rtsopts", [Char]
"-threaded"]
            -- This has essentially no overhead.  A small initialization
            -- overhead which should go away in 9.4.
            , [[Char]
"-eventlog" | Config -> Bool
Config.enableEventLog Config
localConfig Bool -> Bool -> Bool
&& Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Opt]
            , [[Char]
"-dynamic" | Mode
mode forall a. Eq a => a -> a -> Bool
/= Mode
Profile]
            , [[Char]
"-prof" | Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Profile]
            , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-L"<>) (Config -> [[Char]]
Config.globalLibDirs Config
localConfig)
            , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-framework-path="<>)
                (Config -> [[Char]]
Config.extraFrameworkPaths Config
localConfig)
            ]
        , packageDbs :: [[Char]]
packageDbs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. (a, b) -> a
fst Maybe ([[Char]], [PackageId])
packageDbIds
        , packageIds :: [PackageId]
packageIds = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. (a, b) -> b
snd Maybe ([[Char]], [PackageId])
packageDbIds
        }
    -- This one breaks the monoid pattern because it groups other flags,
    -- which is because the flags are a mess and not in any kind of normal
    -- form.
    setGlobalCcFlags :: Mode -> Flags -> Flags
setGlobalCcFlags Mode
mode Flags
flags = Flags
flags
        { globalCcFlags :: [[Char]]
globalCcFlags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ Flags -> [[Char]]
define Flags
flags
            , Flags -> [[Char]]
cInclude Flags
flags
            , case Mode
mode of
                Mode
Opt -> [[Char]
"-O2"]
                Mode
Debug -> [[Char]
"-ggdb"]
                Mode
_ -> []
            , [[Char]
"-Wall"]
            -- I'd like to turn on -Wold-style-cast, but faust uses it a lot
            , [[Char]
"-std=c++11"]
            , [[Char]
"-fPIC"] -- necessary for ghci loading to work in 7.8
            -- Turn on Effective C++ warnings, which includes uninitialized
            -- variables.  Unfortunately it's very noisy with lots of false
            -- positives.  Also, this is only for g++.
            -- , ["-Weffc++"]
            ]
        }
    osFlags :: MidiConfig -> Flags
osFlags MidiConfig
midi = case Platform
Util.platform of
        -- In C and C++ programs the OS specific defines like __APPLE__ and
        -- __linux__ are already defined, but ghc doesn't define them.
        Platform
Util.Mac -> forall a. Monoid a => a
mempty
            -- These apparently control which APIs are visible.  But they
            -- make it slightly more awkward for ghci since it needs the
            -- same flags to load .o files, and things seem to work without
            -- them, so I'll omit them for the time being.
            -- { define = ["-DMAC_OS_X_VERSION_MAX_ALLOWED=1060",
            --     "-DMAC_OS_X_VERSION_MIN_REQUIRED=1050"]
            { define :: [[Char]]
define = [[Char]
"-D__APPLE__"]
            , midiLd :: [[Char]]
midiLd = if MidiConfig
midi forall a. Eq a => a -> a -> Bool
== MidiConfig
CoreMidi
                then [[Char]] -> [[Char]]
frameworks [[Char]
"CoreFoundation", [Char]
"CoreMIDI", [Char]
"CoreAudio"]
                else []
            -- librubberband uses this.  TODO I really need modular libraries!
            , hLinkFlags :: [[Char]]
hLinkFlags = [[Char]] -> [[Char]]
frameworks [[Char]
"Accelerate"]
            }
        Platform
Util.Linux -> forall a. Monoid a => a
mempty
            { midiLd :: [[Char]]
midiLd = if MidiConfig
midi forall a. Eq a => a -> a -> Bool
== MidiConfig
JackMidi
                -- -ljack is needed for PortAudio.initialize, or it will fail
                -- with errors like "Client name conflicts with another running
                -- client".  Why must jack be so unfriendly?
                then [[Char]
"-ljack"]
                else []
            , define :: [[Char]]
define = [[Char]
"-D__linux__"]
            }
    run :: [Char] -> [[Char]] -> IO [Char]
run [Char]
cmd [[Char]]
args = [Char] -> [Char]
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
Process.readProcess [Char]
cmd [[Char]]
args [Char]
""
    frameworks :: [[Char]] -> [[Char]]
frameworks = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
f -> [[Char]
"-framework", [Char]
f])

configureFltk :: FilePath -> IO (String, [Flag], [Flag])
configureFltk :: [Char] -> IO ([Char], [[Char]], [[Char]])
configureFltk [Char]
fltkConfig = do
    [Char]
fltkVersion <- [Char] -> [[Char]] -> IO [Char]
run [Char]
fltkConfig [[Char]
"--version"]
    [[Char]]
fltkCs <- forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
wantCflag forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> IO [Char]
run [Char]
fltkConfig [[Char]
"--cflags"]
    -- The problem is that I have to pass these flags to both ghc and
    -- gcc/clang.  I'm preprocessing these for ghc, but it's probably incorrect
    -- for gcc.  TODO: fix this, mangle for gcc only on the hs link line.
    -- TODO: newer fltk passes -pthread, which apparently just adds -lpthread
    -- and some defines, which are already in there.  This is extra weird
    -- because gcc passes to the linker via -Wl,xyz while ghc uses -optl=xyz.
    -- But ghc's -optl is not actually the linker, but the compiler.
    [[Char]]
fltkLds <- forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
wrapLd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=[Char]
"-pthread") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Char] -> [[Char]] -> IO [Char]
run (Config -> [Char]
Config.fltkConfig Config
localConfig) [[Char]
"--ldflags"]
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fltkVersion, [[Char]]
fltkCs, [[Char]]
fltkLds)
    where
    -- fltk-config --cflags started putting -g and -O2 in the flags, which
    -- messes up hsc2hs, which wants only CPP flags.
    wantCflag :: [Char] -> Bool
wantCflag [Char]
w = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> (Char
'-'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:[Char]
"") forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
w) [Char
'I', Char
'D']
    -- I get -Wl,-rpath,/nix/store/... stuff from nix.
    -- TODO probably wrong?  See above.
    wrapLd :: [Char] -> [Char]
wrapLd [Char]
flag
        | [Char]
"-Wl," forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
flag = [Char]
"-optl=" forall a. Semigroup a => a -> a -> a
<> [Char]
flag
        | Bool
otherwise = [Char]
flag
    run :: [Char] -> [[Char]] -> IO [Char]
run [Char]
cmd [[Char]]
args = [Char] -> [Char]
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
Process.readProcess [Char]
cmd [[Char]]
args [Char]
""

-- | Flags used by both ghc and haddock.  This is unlike 'hcFlags', which is
-- used by ghc only, and vary based on Mode.
ghcGlobalFlags :: [Flag]
ghcGlobalFlags :: [[Char]]
ghcGlobalFlags =
    -- There's no particular reason for --nomacro, except I don't use
    -- them, and I don't want to start unless for good reason.
    [[Char]
"-pgmP", [Char]
"cpphs --nomacro --cpp"] forall a. [a] -> [a] -> [a]
++ [[Char]]
ghcLanguageFlags
    -- https://gitlab.haskell.org/ghc/ghc/issues/17185

-- | Language extensions which are globally enabled.
ghcLanguageFlags :: [Flag]
ghcLanguageFlags :: [[Char]]
ghcLanguageFlags = forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-X"++)
    -- Pretty conservative, and useful.
    [ [Char]
"BangPatterns"
    , [Char]
"DeriveGeneric"
    -- This enables slightly more concise record initialization and doesn't
    -- seem to hurt anything.
    , [Char]
"DisambiguateRecordFields"
    -- ghc-7.10 adds a new rule where you can't infer a signature you can't
    -- type.  OverloadedStrings combined with local definitions results in
    -- a lot of types like "IsString [a] => [a] -> ...", which results in
    -- "Non type-variable argument in the constraint: IsString [a]".
    , [Char]
"FlexibleContexts"
    -- Allow instances on nested types
    , [Char]
"FlexibleInstances"
    -- Just too useful.
    , [Char]
"GeneralizedNewtypeDeriving"
    , [Char]
"LambdaCase"
    , [Char]
"MultiWayIf"
    -- Used to be standard, 9.2 removed it
    , [Char]
"NondecreasingIndentation"
    -- Allow _s in numbers. Harmless, and the _s are nice.
    , [Char]
"NumericUnderscores"
    -- Without this, it becomes really annoying to use Text everywhere.
    , [Char]
"OverloadedStrings"
    , [Char]
"ScopedTypeVariables"
    -- It's nicer than flip (,), but not worth using if you have to put in
    -- a LANGUAGE.
    , [Char]
"TupleSections"
    -- Allow instances on fully applied type synonyms.
    , [Char]
"TypeSynonymInstances"
    ]

-- | When using gcc I get these defines automatically, but I need to add them
-- myself for ghci.  But then c2hs complains about duplicate definitions, so
-- filter them back out for that.  Nothing you can't fix by layering on another
-- hack!
platformDefines :: [Flag]
platformDefines :: [[Char]]
platformDefines = [[Char]
"-D__APPLE__", [Char]
"-D__linux__"]

packageFlags :: Flags -> Maybe FilePath -> [Flag]
packageFlags :: Flags -> Maybe [Char] -> [[Char]]
packageFlags Flags
flags Maybe [Char]
mbHs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Flags -> [PackageId]
packageIds Flags
flags) =
        forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-package="<>) ([[Char]]
extra forall a. [a] -> [a] -> [a]
++ [[Char]]
enabledPackages)
    | Bool
otherwise = [Char]
"-no-user-package-db" forall a. a -> [a] -> [a]
: [Char]
"-hide-all-packages"
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-package-db="<>) (Flags -> [[Char]]
packageDbs Flags
flags)
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(Util.PackageId [Char]
pkg) -> [Char]
"-package-id=" forall a. Semigroup a => a -> a -> a
<> [Char]
pkg)
            (Flags -> [PackageId]
packageIds Flags
flags)
    where
    extra :: [[Char]]
extra = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Char] -> [[Char]]
extraPackagesFor Maybe [Char]
mbHs

-- | This is a hack so I can add packages that aren't in 'enabledPackages'.
-- This is for packages with tons of dependencies that I usually don't need.
extraPackagesFor :: FilePath -> [Package]
extraPackagesFor :: [Char] -> [[Char]]
extraPackagesFor [Char]
hs
    | [Char]
criterionHsSuffix forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs = [[Char]
"criterion"]
    | Bool
otherwise = []

-- | Parse the GHC version out of the @ghc --print-libdir@ path.  Technically
-- I should probably use ghc --numeric-version, but I already have libdir so
-- let's not run ghc again.
parseGhcVersion :: FilePath -> (Int, Int, Int)
parseGhcVersion :: [Char] -> (Int, Int, Int)
parseGhcVersion [Char]
path =
    forall a. a -> Maybe a -> a
Maybe.fromMaybe (forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"parseGhcVersion: can't parse " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
path) forall a b. (a -> b) -> a -> b
$
        [Char] -> Maybe (Int, Int, Int)
parse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ([Char]
prefix `List.isPrefixOf`) (forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split [Char]
"/" [Char]
path)
    where
    prefix :: [Char]
prefix = [Char]
"ghc-"
    parse :: [Char] -> Maybe (Int, Int, Int)
parse [Char]
cs = case forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split [Char]
"." (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
prefix) [Char]
cs) of
        -- take 3 to avoid getting confused by versions like 8.0.1.20161213.
        [Char]
a : [Char]
b : [Char]
c : [[Char]]
_ ->
            (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
Read.readMaybe [Char]
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> Maybe a
Read.readMaybe [Char]
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> Maybe a
Read.readMaybe [Char]
c
        [[Char]]
_ -> forall a. Maybe a
Nothing

-- | Generate a number CPP can compare.
ghcVersionMacro :: (Int, Int, Int) -> String
ghcVersionMacro :: (Int, Int, Int) -> [Char]
ghcVersionMacro (Int
a, Int
b, Int
c) =
    forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'0') forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> [Char]
pad0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Int
a, Int
b, Int
c]
    where
    pad0 :: [Char] -> [Char]
pad0 [Char
c] = Char
'0' forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: []
    pad0 [Char]
cs = [Char]
cs

type InferConfig = FilePath -> Config

-- | Figure out the Config for a given target by looking at its directory.
inferConfig :: (Mode -> Config) -> InferConfig
inferConfig :: (Mode -> Config) -> InferConfig
inferConfig Mode -> Config
modeConfig = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Mode -> Config
modeConfig Mode
Debug) Mode -> Config
modeConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Mode
targetToMode

-- * rules

main :: IO ()
main :: IO ()
main = forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
Concurrent.withConcurrentOutput forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
Regions.displayConsoleRegions forall a b. (a -> b) -> a -> b
$ do
    Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
IO.stdout BufferMode
IO.LineBuffering
    [([Char], [Char])]
env <- IO [([Char], [Char])]
Environment.getEnvironment
    Mode -> Config
modeConfig <- IO (Mode -> Config)
configure
    [[Char]]
args <- IO [[Char]]
Environment.getArgs
    -- Special mode to show the auto detected config.
    case [[Char]]
args of
        [[Char]
"debug"] -> Config -> IO ()
printConfig forall a b. (a -> b) -> a -> b
$ Mode -> Config
modeConfig Mode
Debug
        [[Char]
"opt"] -> Config -> IO ()
printConfig forall a b. (a -> b) -> a -> b
$ Mode -> Config
modeConfig Mode
Opt
        [[Char]
"test"] -> Config -> IO ()
printConfig forall a b. (a -> b) -> a -> b
$ Mode -> Config
modeConfig Mode
Test
        [[Char]
"profile"] -> Config -> IO ()
printConfig forall a b. (a -> b) -> a -> b
$ Mode -> Config
modeConfig Mode
Profile
        [[Char]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Mode -> Config) -> IO ()
writeGhciFlags Mode -> Config
modeConfig
    IO ()
makeDataLinks
    [Char] -> [[Char]] -> IO ()
writeDeps ([Char]
cabalDir [Char] -> [Char] -> [Char]
</> [Char]
"nix-packages") [[Char]]
nixPackages
    forall a.
ShakeOptions
-> [OptDescr (Either [Char] a)]
-> ([a] -> [[Char]] -> IO (Maybe (Rules ())))
-> IO ()
Shake.shakeArgsWith ([[Char]] -> ShakeOptions
options [[Char]]
args) [] forall a b. (a -> b) -> a -> b
$ \[] [[Char]]
targets -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Rules ()
cabalRule [Char]
"karya.cabal"
        Rules ()
faustRules
        Rules ()
generateKorvais
        [Char] -> [Char] -> Bool
matchBuildDir [Char]
hsconfigH Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> [Char] -> Action ()
hsconfigHRule
        let infer :: InferConfig
infer = (Mode -> Config) -> InferConfig
inferConfig Mode -> Config
modeConfig
        [([Char], [Char])] -> Config -> Rules ()
setupOracle [([Char], [Char])]
env (Mode -> Config
modeConfig Mode
Debug)
        [Char] -> [Char] -> Bool
matchObj [Char]
"fltk/fltk.a" Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
fn -> do
            let config :: Config
config = InferConfig
infer [Char]
fn
            Partial => [[Char]] -> Action ()
need (Config -> [[Char]]
fltkDeps Config
config)
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"ar" forall a b. (a -> b) -> a -> b
$ [[Char]
"-rs", [Char]
fn] forall a. [a] -> [a] -> [a]
++ Config -> [[Char]]
fltkDeps Config
config
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InferConfig -> Binary Config -> Rules ()
cBinaryRule InferConfig
infer) [Binary Config]
ccBinaries
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InferConfig -> HsBinary -> Rules ()
hsBinaryRule InferConfig
infer) [HsBinary]
hsBinaries
        ([Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"*.icns") Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
fn -> do
            -- Build OS X .icns file from .iconset dir.
            let iconset :: [Char]
iconset = [Char]
"doc/icon" [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
nameExt [Char]
fn [Char]
"iconset"
            [[Char]]
icons <- [Char] -> [[Char]] -> Action [[Char]]
Shake.getDirectoryFiles [Char]
"" [[Char]
iconset [Char] -> [Char] -> [Char]
</> [Char]
"*"]
            Partial => [[Char]] -> Action ()
need [[Char]]
icons
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"iconutil" [[Char]
"-c", [Char]
"icns", [Char]
"-o", [Char]
fn, [Char]
iconset]
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
extractableDocs forall a b. (a -> b) -> a -> b
$ \[Char]
fn ->
            [Char]
fn Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> Config -> [Char] -> Action ()
extractDoc (Mode -> Config
modeConfig Mode
Debug)
        Config -> Rules ()
testRules (Mode -> Config
modeConfig Mode
Test)
        Config -> Rules ()
profileRules (Mode -> Config
modeConfig Mode
Profile)
        -- Opt in case profiling flags make a difference, but they can't
        -- use UiTest.
        Config -> Rules ()
criterionRules (Mode -> Config
modeConfig Mode
Opt)
        Config -> Rules ()
criterionRules (Mode -> Config
modeConfig Mode
Profile)
        Config -> Rules ()
criterionRules (Mode -> Config
modeConfig Mode
Test) -- for typecheck-ci
        [Char] -> Rules ()
markdownRule (Config -> [Char]
buildDir (Mode -> Config
modeConfig Mode
Opt) [Char] -> [Char] -> [Char]
</> [Char]
"linkify")
        Config -> Rules ()
hsc2hsRule (Mode -> Config
modeConfig Mode
Debug) -- hsc2hs only uses mode-independent flags
        Config -> Rules ()
chsRule (Mode -> Config
modeConfig Mode
Debug)
        InferConfig -> Rules ()
hsOHiRule InferConfig
infer
        InferConfig -> Rules ()
ccORule InferConfig
infer
        (Mode -> Config) -> [[Char]] -> Rules ()
dispatch Mode -> Config
modeConfig [[Char]]
targets

printConfig :: Config -> IO ()
printConfig :: Config -> IO ()
printConfig Config
config = do
    forall a. Show a => a -> IO ()
PPrint.pprint Config
config
    forall a. IO a
Exit.exitSuccess

-- ** oracle

newtype Question a = Question () deriving
    ( Int -> Question a -> [Char] -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall k (a :: k). Int -> Question a -> [Char] -> [Char]
forall k (a :: k). [Question a] -> [Char] -> [Char]
forall k (a :: k). Question a -> [Char]
showList :: [Question a] -> [Char] -> [Char]
$cshowList :: forall k (a :: k). [Question a] -> [Char] -> [Char]
show :: Question a -> [Char]
$cshow :: forall k (a :: k). Question a -> [Char]
showsPrec :: Int -> Question a -> [Char] -> [Char]
$cshowsPrec :: forall k (a :: k). Int -> Question a -> [Char] -> [Char]
Show, Typeable.Typeable, Question a -> Question a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Question a -> Question a -> Bool
/= :: Question a -> Question a -> Bool
$c/= :: forall k (a :: k). Question a -> Question a -> Bool
== :: Question a -> Question a -> Bool
$c== :: forall k (a :: k). Question a -> Question a -> Bool
Eq, Int -> Question a -> Int
Question a -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall k (a :: k). Eq (Question a)
forall k (a :: k). Int -> Question a -> Int
forall k (a :: k). Question a -> Int
hash :: Question a -> Int
$chash :: forall k (a :: k). Question a -> Int
hashWithSalt :: Int -> Question a -> Int
$chashWithSalt :: forall k (a :: k). Int -> Question a -> Int
Hashable.Hashable, Get (Question a)
[Question a] -> Put
Question a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
forall k (a :: k). Get (Question a)
forall k (a :: k). [Question a] -> Put
forall k (a :: k). Question a -> Put
putList :: [Question a] -> Put
$cputList :: forall k (a :: k). [Question a] -> Put
get :: Get (Question a)
$cget :: forall k (a :: k). Get (Question a)
put :: Question a -> Put
$cput :: forall k (a :: k). Question a -> Put
Binary.Binary
    , Question a -> ()
forall a. (a -> ()) -> NFData a
forall k (a :: k). Question a -> ()
rnf :: Question a -> ()
$crnf :: forall k (a :: k). Question a -> ()
DeepSeq.NFData
    )

data GhcQ deriving (Typeable.Typeable)
type instance Shake.RuleResult (Question GhcQ) = String

data FltkQ deriving (Typeable.Typeable)
type instance Shake.RuleResult (Question FltkQ) = String

data ReplQ deriving (Typeable.Typeable)
type instance Shake.RuleResult (Question ReplQ) = Bool

data MidiQ deriving (Typeable.Typeable)
type instance Shake.RuleResult (Question MidiQ) = String

setupOracle :: [(String, String)] -> Config -> Shake.Rules ()
setupOracle :: [([Char], [Char])] -> Config -> Rules ()
setupOracle [([Char], [Char])]
env Config
config = do
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
Shake.addOracle forall a b. (a -> b) -> a -> b
$ \(Question GhcQ
_ :: Question GhcQ) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> [Char]
ghcLib Config
config)
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
Shake.addOracle forall a b. (a -> b) -> a -> b
$ \(Question FltkQ
_ :: Question FltkQ) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> [Char]
fltkVersion Config
config)
    -- Previously, linking ghc took so long it was worth linking without the
    -- REPL.  But dynamic linking is fast enough that I can reverse it, and
    -- eventually remove norepl if I never wind up using it.
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
Shake.addOracle forall a b. (a -> b) -> a -> b
$ \(Question ReplQ
_ :: Question ReplQ) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"norepl" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], [Char])]
env)
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
Shake.addOracle forall a b. (a -> b) -> a -> b
$ \(Question MidiQ
_ :: Question MidiQ) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
midiDriver :: String)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
    midiDriver :: [Char]
midiDriver = case [([Char], [Char])] -> MidiConfig
midiFromEnv [([Char], [Char])]
env of
        MidiConfig
StubMidi -> [Char]
"STUB_MIDI"
        MidiConfig
JackMidi -> [Char]
"JACK_MIDI"
        MidiConfig
CoreMidi -> [Char]
"CORE_MIDI"

midiFromEnv :: [(String, String)] -> MidiConfig
midiFromEnv :: [([Char], [Char])] -> MidiConfig
midiFromEnv [([Char], [Char])]
env = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"midi" [([Char], [Char])]
env of
      Just [Char]
"stub" -> MidiConfig
StubMidi
      Just [Char]
"jack" -> MidiConfig
JackMidi
      Just [Char]
"core" -> MidiConfig
CoreMidi
      Just [Char]
unknown -> forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"midi driver should be stub, jack, or core: "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
unknown
      Maybe [Char]
Nothing -> case Platform
Util.platform of
          Platform
Util.Mac -> MidiConfig
CoreMidi
          Platform
Util.Linux -> MidiConfig
JackMidi

-- ** misc rules

-- | Dynamically generated header.
hsconfigH :: FilePath
hsconfigH :: [Char]
hsconfigH = [Char]
"hsconfig.h"

hsconfigPath :: Config -> FilePath
hsconfigPath :: Config -> [Char]
hsconfigPath Config
config = Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
hsconfigH

-- | Write a header to configure the haskell compilation.
--
-- It's in a separate file so that the relevant haskell files can include it.
-- This way only those files will recompile when the config changes.
hsconfigHRule :: FilePath -> Shake.Action ()
hsconfigHRule :: [Char] -> Action ()
hsconfigHRule [Char]
fn = do
    -- I probably don't need this because the oracles should notice changes,
    -- but it's cheap to run and writeFileChanged won't cause further
    -- rebuilding, so let's just run it.
    Action ()
Shake.alwaysRerun
    Bool
useRepl <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
Shake.askOracle (forall {k} (a :: k). () -> Question a
Question () :: Question ReplQ)
    Bool
useRepl <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
useRepl Bool -> Bool -> Bool
&& [Char] -> Maybe Mode
targetToMode [Char]
fn forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Mode
Test
    [Char]
midiDriver <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
Shake.askOracle (forall {k} (a :: k). () -> Question a
Question () :: Question MidiQ)
    forall (m :: * -> *).
(MonadIO m, Partial) =>
[Char] -> [Char] -> m ()
Shake.writeFileChanged [Char]
fn forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
        [ [Char]
"/* Created automatically by the shakefile. */"
        , [Char]
"#pragma once"
        , Bool -> [Char] -> [Char]
define Bool
useRepl [Char]
"INTERPRETER_GHC"
        , Bool -> [Char] -> [Char]
define Bool
True [Char]
midiDriver
        , Bool -> [Char] -> [Char]
define (Config -> Bool
Config.enableEkg Config
localConfig) [Char]
"USE_EKG"
        , Bool -> [Char] -> [Char]
define Bool
True [Char]
"ENABLE_IM"
        ]
    where
    define :: Bool -> [Char] -> [Char]
define Bool
b [Char]
name = (if Bool
b then [Char]
"#define " else [Char]
"#undef ") forall a. [a] -> [a] -> [a]
++ [Char]
name

-- | Match a file in @build/<mode>/obj/@ or @build/<mode>/@.
matchObj :: Shake.FilePattern -> FilePath -> Bool
matchObj :: [Char] -> [Char] -> Bool
matchObj [Char]
pattern [Char]
fn =
    [[Char]] -> [Char] -> [Char] -> Bool
matchPrefix (forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char] -> [Char]
</> [Char]
"obj") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Char]
modeToDir) [Mode]
allModes) [Char]
pattern [Char]
fn
    Bool -> Bool -> Bool
|| [[Char]] -> [Char] -> [Char] -> Bool
matchPrefix (forall a b. (a -> b) -> [a] -> [b]
map Mode -> [Char]
modeToDir [Mode]
allModes) [Char]
pattern [Char]
fn

-- | Match a file in @build/<mode>/@.
matchBuildDir :: Shake.FilePattern -> FilePath -> Bool
matchBuildDir :: [Char] -> [Char] -> Bool
matchBuildDir = [[Char]] -> [Char] -> [Char] -> Bool
matchPrefix (forall a b. (a -> b) -> [a] -> [b]
map Mode -> [Char]
modeToDir [Mode]
allModes)

matchPrefix :: [Shake.FilePattern] -> Shake.FilePattern -> FilePath -> Bool
matchPrefix :: [[Char]] -> [Char] -> [Char] -> Bool
matchPrefix [[Char]]
prefixes [Char]
pattern [Char]
fn =
    case forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> Maybe [Char]
dropPrefix [Char]
fn) [[Char]]
prefixes of
        Maybe [Char]
Nothing -> Bool
False
        Just [Char]
rest -> [Char]
pattern [Char] -> [Char] -> Bool
?== forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'/') [Char]
rest

dispatch :: (Mode -> Config) -> [String] -> Shake.Rules ()
dispatch :: (Mode -> Config) -> [[Char]] -> Rules ()
dispatch Mode -> Config
modeConfig [[Char]]
targets
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
targets = forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"no mk targets, valid targets are:\n" forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unlines
        [ [Char]
"- any target in build/{debug,opt,test,profile}/xyz"
        , [Char]
"- tests-xyz where xyz is a RunTests-xyz target"
        , [Char]
"- one of: " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unwords (forall k a. Map k a -> [k]
Map.keys Map [Char] (Rules Bool)
specialTargets)
        ]
    | Bool
otherwise = do
        [Bool]
handled <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> Rules Bool
hardcoded [[Char]]
targets
        Partial => [[Char]] -> Rules ()
Shake.want [[Char]
target | (Bool
False, [Char]
target) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
handled [[Char]]
targets]
    where
    allBinaries :: [[Char]]
allBinaries = forall a b. (a -> b) -> [a] -> [b]
map HsBinary -> [Char]
hsName [HsBinary]
hsBinaries forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall config. Binary config -> [Char]
C.binName [Binary Config]
ccBinaries
    hardcoded :: [Char] -> Rules Bool
hardcoded [Char]
target
        | Just Rules Bool
run <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
target Map [Char] (Rules Bool)
specialTargets = Rules Bool
run
        | Just [Char]
tests <- [Char] -> [Char] -> Maybe [Char]
dropPrefix [Char]
"tests-" [Char]
target = forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ do
            Partial => [[Char]] -> Action ()
need [Maybe [Char] -> [Char]
runTestsTarget (forall a. a -> Maybe a
Just [Char]
tests)]
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/run_tests" [Maybe [Char] -> [Char]
runTestsTarget (forall a. a -> Maybe a
Just [Char]
tests)]
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    specialTargets :: Map [Char] (Rules Bool)
specialTargets = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        -- I should probably run this in keepGoing mode, -k.
        [ ([Char]
"validate",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ do
            -- Unfortunately, verify_performance is the only binary in
            -- opt, which causes most of the opt tree to build.  I could build
            -- a debug one, but debug deriving is really slow.
            let opt :: [Char] -> [Char]
opt = (Mode -> [Char]
modeToDir Mode
Opt </>)
            [[Char]] -> Action ()
needEverything [[Char] -> [Char]
opt [Char]
"verify_performance", [Char]
runTests, [Char]
runProfileTest]
            Action ()
allTests
            [Char] -> Action ()
Util.shell forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
opt [Char]
"verify_performance --out=build/verify\
                \ save/complete/*"
        , ([Char]
"verify",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ do
            let opt :: [Char] -> [Char]
opt = (Mode -> [Char]
modeToDir Mode
Opt </>)
            Partial => [[Char]] -> Action ()
need [[Char] -> [Char]
opt [Char]
"verify_performance"]
            [Char] -> Action ()
Util.shell forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
opt [Char]
"verify_performance --out=build/verify\
                \ save/complete/*"
        -- Compile everything, like validate but when I don't want to test.
        , ([Char]
"typecheck",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ [[Char]] -> Action ()
needEverything []
        -- Like typecheck, but compile everything as Test, which speeds things
        -- up a lot.  This is for running on CI, so also omit things I know
        -- won't build there.
        , ([Char]
"typecheck-ci",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action Action ()
needEverythingCI
        , ([Char]
"binaries",) forall a b. (a -> b) -> a -> b
$ do
            Partial => [[Char]] -> Rules ()
Shake.want forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Mode -> [Char]
modeToDir Mode
Opt </>) [[Char]]
allBinaries
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        , ([Char]
"clean",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ do
            -- The shake database will remain because shake creates it after the
            -- shakefile runs, but that's probably ok.
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"rm" [[Char]
"-rf", [Char]
build]
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"mkdir" [[Char]
build]
        , ([Char]
"doc",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ (Mode -> Config) -> Action ()
makeAllDocumentation Mode -> Config
modeConfig
        , ([Char]
"haddock",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ (Mode -> Config) -> Action [[Char]]
makeHaddock Mode -> Config
modeConfig
        , ([Char]
"hlint",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ Config -> Action ()
hlint (Mode -> Config
modeConfig Mode
Debug)
        , ([Char]
"md",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ Partial => [[Char]] -> Action ()
need forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
docToHtml forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Action [[Char]]
getMarkdown
        , ([Char]
"profile",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ do
            Partial => [[Char]] -> Action ()
need [[Char]
runProfile]
            let with_scc :: Bool
with_scc = [Char]
"-fprof-auto-top"
                    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Flags -> [[Char]]
hcFlags (Config -> Flags
configFlags (Mode -> Config
modeConfig Mode
Profile))
            [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/summarize_profile.py"
                [if Bool
with_scc then [Char]
"scc" else [Char]
"no-scc"]
        , ([Char]
"show-debug",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
PPrint.pprint (Mode -> Config
modeConfig Mode
Debug)
        , ([Char]
"show-opt",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
PPrint.pprint (Mode -> Config
modeConfig Mode
Opt)
        , ([Char]
"tests",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action Action ()
allTests
        -- Run tests with no tags.
        , ([Char]
"tests-normal",) forall a b. (a -> b) -> a -> b
$ forall {a}. Action a -> Rules Bool
action Action ()
fastTests
        ]
    action :: Action a -> Rules Bool
action Action a
act = forall a. Partial => Action a -> Rules ()
Shake.action Action a
act forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    runTestsTarget :: Maybe [Char] -> [Char]
runTestsTarget Maybe [Char]
tests = [Char]
runTests forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (Char
'-':) Maybe [Char]
tests
    needEverything :: [[Char]] -> Action ()
needEverything [[Char]]
more = do
        [[Char]]
criterion <- Config -> Action [[Char]]
getCriterionTargets (Mode -> Config
modeConfig Mode
Profile)
        Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Mode -> [Char]
modeToDir Mode
Debug </>) [[Char]]
allBinaries
            forall a. [a] -> [a] -> [a]
++ [[Char]]
criterion forall a. [a] -> [a] -> [a]
++ [[Char]
runTests, [Char]
runProfile] forall a. [a] -> [a] -> [a]
++ [[Char]]
more
    -- See typecheck-ci
    needEverythingCI :: Action ()
needEverythingCI = do
        -- TODO: include criterion in the deps to re-enable this.
        -- criterion <- getCriterionTargets (modeConfig Test)
        Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Mode -> [Char]
modeToDir Mode
Test </>)
                (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
cantBuild) [[Char]]
allBinaries)
            -- ++ criterion
            forall a. [a] -> [a] -> [a]
++ [[Char]
runTests]
            -- This is missing runProfile, but at the moment I can't be
            -- bothered to get that to compile in build/test.
        where
        cantBuild :: [[Char]]
cantBuild = [forall config. Binary config -> [Char]
C.binName Binary Config
playCacheBinary]

fastTests :: Shake.Action ()
fastTests :: Action ()
fastTests = do
    Partial => [[Char]] -> Action ()
need [[Char]
runTests]
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/run_tests" [[Char]
runTests, [Char]
"^normal-"]

allTests :: Shake.Action ()
allTests :: Action ()
allTests = do
    Partial => [[Char]] -> Action ()
need [[Char]
runTests, [Char]
runProfileTest]
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/run_tests" [[Char]
runTests, [Char]
runProfileTest, [Char]
"^normal-"]

hlint :: Config -> Shake.Action ()
hlint :: Config -> Action ()
hlint Config
config = do
    [[Char]]
hs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Config -> IO [[Char]]
getAllHs (forall a. a -> Maybe a
Just Config
config)
    Partial => [[Char]] -> Action ()
need [[Char]]
hs
    [Char] -> [[Char]] -> Action ()
Util.systemKeepGoing [Char]
"hlint" forall a b. (a -> b) -> a -> b
$
        [ [Char]
"--report=" forall a. Semigroup a => a -> a -> a
<> [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"hlint.html"
        , [Char]
"--cpp-define=TESTING"
        , [Char]
"--cpp-include=" forall a. Semigroup a => a -> a -> a
<> Config -> [Char]
buildDir Config
config
        ] forall a. [a] -> [a] -> [a]
++ [[Char]]
hs

-- ** doc

-- | Make all documentation.
makeAllDocumentation :: (Mode -> Config) -> Shake.Action ()
makeAllDocumentation :: (Mode -> Config) -> Action ()
makeAllDocumentation Mode -> Config
modeConfig = do
    [[Char]]
docs <- Action [[Char]]
getMarkdown
    Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ [[Char]]
extractableDocs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
docToHtml [[Char]]
docs
    [[Char]]
_ <- (Mode -> Config) -> Action [[Char]]
makeHaddock Mode -> Config
modeConfig
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Docs produced by extract_doc.
extractableDocs :: [FilePath]
extractableDocs :: [[Char]]
extractableDocs =
    forall a b. (a -> b) -> [a] -> [b]
map ([Char]
buildDocDir </>) [[Char]
"keymap.html", [Char]
"calls.html", [Char]
"scales.html"]

extractDoc :: Config -> FilePath -> Shake.Action ()
extractDoc :: Config -> [Char] -> Action ()
extractDoc Config
config [Char]
fn = do
    let bin :: [Char]
bin = Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"extract_doc"
    Partial => [[Char]] -> Action ()
need [[Char]
bin]
    let name :: [Char]
name = [Char] -> [Char]
FilePath.takeFileName ([Char] -> [Char]
FilePath.dropExtension [Char]
fn)
    [Char] -> Action ()
Util.shell forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
bin, [Char]
name, [Char]
">", [Char]
fn]

getMarkdown :: Shake.Action [FilePath]
getMarkdown :: Action [[Char]]
getMarkdown = forall a b. (a -> b) -> [a] -> [b]
map ([Char]
docDir</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> Action [[Char]]
Shake.getDirectoryFiles [Char]
docDir [[Char]
"*.md"]

-- TODO This always generates haddock, even if no input files have changed.
-- I used to use Util.findHs in 'getAllHs', but it still always generated, so
-- using command all_hs.py is not the problem.
makeHaddock :: (Mode -> Config) -> Shake.Action [FilePath]
makeHaddock :: (Mode -> Config) -> Action [[Char]]
makeHaddock Mode -> Config
modeConfig = do
    let config :: Config
config = Mode -> Config
modeConfig Mode
Debug
    [[Char]]
hs <- forall a. (a -> Bool) -> [a] -> [a]
filter (Config -> [Char] -> Bool
wantsHaddock Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Config -> IO [[Char]]
getAllHs (forall a. a -> Maybe a
Just Config
config))
    Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ Config -> [Char]
hsconfigPath Config
config forall a. a -> [a] -> [a]
: [[Char]]
hs
    let flags :: Flags
flags = Config -> Flags
configFlags Config
config
    [[Char]]
interfaces <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [[Char]] -> IO [[Char]]
getHaddockInterfaces (Flags -> Maybe [Char] -> [[Char]]
packageFlags Flags
flags forall a. Maybe a
Nothing)
    Entry
entry <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO (Either [Char] Entry)
SourceControl.current [Char]
"."
    let title :: Text
title = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Karya, built on "
            , UTCTime -> Text
SourceControl.showDate (Entry -> UTCTime
SourceControl._date Entry
entry)
            , Text
" (patch ", Entry -> Text
SourceControl._hash Entry
entry, Text
")"
            ]
    -- This is like 'ghcFlags', but haddock takes slightly different flags.
    [[Char]]
includeFlags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Flags -> IO [[Char]]
cIncludeUnwrapped Flags
flags
    let ghcFlags :: [[Char]]
ghcFlags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]]
ghcGlobalFlags
            , Flags -> [[Char]]
define Flags
flags
            , [[Char]]
includeFlags
            , Flags -> Maybe [Char] -> [[Char]]
packageFlags Flags
flags forall a. Maybe a
Nothing
            , [[Char]
"-i" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
":" [Config -> [Char]
hscDir Config
config, Config -> [Char]
chsDir Config
config]]
            ]
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
"haddock" forall a b. (a -> b) -> a -> b
$
        [ [Char]
"--html"
        , [Char]
"-B", Config -> [Char]
ghcLib Config
config
        , [Char]
"--title=" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
title
        , [Char]
"--hyperlinked-source"
        , [Char]
"--prologue=doc/prologue"
        , [Char]
"--package-name=karya" -- otherwise it warns incessantly
        -- Don't report every single function without a doc.
        , [Char]
"--no-print-missing-docs"
        -- Source references qualified names as written in the doc.
        , [Char]
"--qual=aliased"
        , [Char]
"-o", [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"haddock"
        ] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--read-interface="<>) [[Char]]
interfaces
        , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--optghc="<>) [[Char]]
ghcFlags
        , [[Char]]
hs
        ]
    forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
hs

-- | Get paths to haddock interface files for all the packages.
getHaddockInterfaces :: [Flag] -> IO [String]
getHaddockInterfaces :: [[Char]] -> IO [[Char]]
getHaddockInterfaces [[Char]]
packageDbFlags = do
    -- ghc-pkg annoyingly provides no way to get a field from a list of
    -- packages.
    --
    -- TODO why do I have to do this?  Isn't there a less manual way to run
    -- haddock?
    [[Char]]
interfaces <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
packages forall a b. (a -> b) -> a -> b
$ \[Char]
package ->
        [Char] -> [[Char]] -> [Char] -> IO [Char]
Process.readProcess [Char]
"ghc-pkg"
            ([[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
"field", [Char]
package, [Char]
"haddock-interfaces"])
            [Char]
""
    -- Some pkgs, like primitive, don't seem to to include .haddock for some
    -- reason.
    forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
Directory.doesPathExist forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
extract [[Char]]
interfaces
    where
    -- --unit-id lets the -package-id flags work, necessary for v2.
    -- --global re-enables the global db, necessary for bootlibs.
    flags :: [[Char]]
flags
        | Config -> Bool
Config.useCabalV2 Config
localConfig = [Char]
"--unit-id" forall a. a -> [a] -> [a]
: [Char]
"--global" forall a. a -> [a] -> [a]
: [[Char]]
packageDbs
        | Bool
otherwise = [[Char]]
packageDbs
    -- ghc-pkg uses similar but not the same flags as ghc itself.
    -- TODO get them directly from Flags, where packageDbs and packageIds are
    -- still separated
    ([[Char]]
packageDbs, [[Char]]
packages) = forall a b. [Either a b] -> ([a], [b])
Either.partitionEithers forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe [Char] -> Maybe (Either [Char] [Char])
adjust [[Char]]
packageDbFlags
    adjust :: [Char] -> Maybe (Either [Char] [Char])
adjust [Char]
flag
        | [Char]
"-package-db=" forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
flag = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"-" forall a. Semigroup a => a -> a -> a
<> [Char]
flag
        | ([Char]
pkg, Bool
True) <- forall a. Eq a => [a] -> [a] -> ([a], Bool)
Lists.dropPrefix [Char]
"-package-id=" [Char]
flag = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Char]
pkg
        | ([Char]
pkg, Bool
True) <- forall a. Eq a => [a] -> [a] -> ([a], Bool)
Lists.dropPrefix [Char]
"-package=" [Char]
flag = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Char]
pkg
        | [Char]
flag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"-no-user-package-db", [Char]
"-hide-all-packages"] = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unrecognized packageDbFlags flag: " forall a. Semigroup a => a -> a -> a
<> [Char]
flag
    extract :: [Char] -> [Char]
extract = forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n')

-- | Get all hs files in the repo, in their .hs form (so it's the generated
-- output from .hsc or .chs).
getAllHs :: Maybe Config -> IO [FilePath]
getAllHs :: Maybe Config -> IO [[Char]]
getAllHs Maybe Config
mbConfig =
    [[Char]] -> [[Char]]
filterHs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Char] -> [[Char]] -> [Char] -> IO [Char]
Process.readProcess [Char]
"git" [[Char]
"ls-tree", [Char]
"--name-only", [Char]
"-r", [Char]
"HEAD"] [Char]
""
    where
    filterHs :: [[Char]] -> [[Char]]
filterHs [[Char]]
fnames = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [[Char]]
hs forall a. a -> [a] -> [a]
: case Maybe Config
mbConfig of
        Maybe Config
Nothing -> [[[Char]]
hsc, [[Char]]
chs]
        Just Config
config ->
            [ forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
hscToHs (Config -> [Char]
hscDir Config
config)) [[Char]]
hsc
            , forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
chsToHs (Config -> [Char]
chsDir Config
config)) [[Char]]
chs
            ]
        where
        ([[Char]]
hs, [[Char]]
fnames1) = forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
get [Char]
".hs" [[Char]]
fnames
        ([[Char]]
hsc, [[Char]]
fnames2) = forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
get [Char]
".hsc" [[Char]]
fnames1
        ([[Char]]
chs, [[Char]]
_fnames3) = forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
get [Char]
".chs" [[Char]]
fnames2
        get :: [a] -> [[a]] -> ([[a]], [[a]])
get [a]
suffix = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ([a]
suffix `List.isSuffixOf`)

-- | Should this module have haddock documentation generated?
wantsHaddock :: Config -> FilePath -> Bool
wantsHaddock :: Config -> [Char] -> Bool
wantsHaddock Config
config [Char]
hs = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$
    [ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isUpper (forall a. [a] -> a
head [Char]
hs) -- no docs for scripts in tools
    , [Char]
"Ness/" forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
hs -- ness stuff still uses conduit-audio
    , [Char]
"_test.hs" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs
    , [Char]
"_profile.hs" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs
    , [Char]
"_criterion.hs" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs
    -- This will crash hsc2hs on OS X since jack.h is likely not present.
    -- TODO NOTE [no-package]
    , MidiConfig
midi forall a. Eq a => a -> a -> Bool
/= MidiConfig
JackMidi Bool -> Bool -> Bool
&& [Char]
hs forall a. Eq a => a -> a -> Bool
== [Char] -> [Char] -> [Char]
hscToHs (Config -> [Char]
hscDir Config
config) [Char]
"Midi/JackMidi.hsc"

    -- Omit test util modules as well.  This is because UiTest has
    -- #ifndef TESTING #error in it to prevent imports from non-tests, but
    -- if I run haddock with -DTESTING, the extra module exports cause tons
    -- of duplicate haddock.  Haddock for test utils is not so important, so
    -- let's just omit them.
    , [Char]
"Test.hs" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs
    , [Char]
"TestInstances.hs" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs
    , [Char]
hs forall a. Eq a => a -> a -> Bool
== [Char]
"Derive/DeriveQuickCheck.hs"
    ]
    where midi :: MidiConfig
midi = Config -> MidiConfig
midiConfig Config
config

-- ** packages

cabalRule :: FilePath -> Shake.Rules ()
cabalRule :: [Char] -> Rules ()
cabalRule [Char]
fn = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Partial => [[Char]] -> Rules ()
Shake.want [[Char]
fn]) forall a b. (a -> b) -> a -> b
$ [Char]
fn Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
_ -> do
    Action ()
Shake.alwaysRerun
    [Char]
template <- Partial => [Char] -> Action [Char]
Shake.readFile' ([Char]
cabalDir [Char] -> [Char] -> [Char]
</> [Char]
"karya.cabal.template")
    forall (m :: * -> *).
(MonadIO m, Partial) =>
[Char] -> [Char] -> m ()
Shake.writeFileChanged [Char]
fn forall a b. (a -> b) -> a -> b
$ [Char]
template forall a. Semigroup a => a -> a -> a
<> [Char]
cabalFile

cabalFile :: String
cabalFile :: [Char]
cabalFile = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Char] -> [[Char]]
declareCondition (forall k a. Map k a -> [k]
Map.keys Map [Char] [([Char], [Char])]
optionalPackages)
    , [ [Char]
""
      , [Char]
"library"
      , Int -> [Char] -> [Char]
indent Int
1 [Char]
"build-tool-depends: cpphs:cpphs, c2hs:c2hs"
      , Int -> [Char] -> [Char]
indent Int
1 [Char]
"build-depends:"
      ]
    , Int -> [([Char], [Char])] -> [[Char]]
dependsList Int
2 [([Char], [Char])]
basicPackages
    , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [([Char], [Char])]) -> [[Char]]
mkCond forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList Map [Char] [([Char], [Char])]
optionalPackages
    ]
    where
    declareCondition :: [Char] -> [[Char]]
declareCondition [Char]
name =
        [ [Char]
"flag " forall a. Semigroup a => a -> a -> a
<> [Char]
name
        , Int -> [Char] -> [Char]
indent Int
1 [Char]
"default: False"
        ]
    mkCond :: ([Char], [([Char], [Char])]) -> [[Char]]
mkCond ([Char]
name, [([Char], [Char])]
pkgs) =
        [ Int -> [Char] -> [Char]
indent Int
1 forall a b. (a -> b) -> a -> b
$ [Char]
"if flag(" forall a. Semigroup a => a -> a -> a
<> [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
")"
        , Int -> [Char] -> [Char]
indent Int
2 [Char]
"build-depends:"
        ] forall a. [a] -> [a] -> [a]
++ Int -> [([Char], [Char])] -> [[Char]]
dependsList Int
3 [([Char], [Char])]
pkgs
    dependsList :: Int -> [([Char], [Char])] -> [[Char]]
dependsList Int
n = forall {a}. (Semigroup a, IsString a) => [a] -> [a]
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int -> ([Char], [Char]) -> [Char]
mkLine Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
List.sort
    mkLine :: Int -> ([Char], [Char]) -> [Char]
mkLine Int
n ([Char]
package, [Char]
constraint) =
        Int -> [Char] -> [Char]
indent Int
n forall a b. (a -> b) -> a -> b
$ [Char]
package forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
constraint then [Char]
"" else [Char]
" " forall a. Semigroup a => a -> a -> a
<> [Char]
constraint
    indent :: Int -> [Char] -> [Char]
indent Int
n = (forall a. Int -> a -> [a]
replicate (Int
nforall a. Num a => a -> a -> a
*Int
4) Char
' ' <>)
    commas :: [a] -> [a]
commas [a
x] = [a
x]
    commas (a
x:[a]
xs) = a
x forall a. Semigroup a => a -> a -> a
<> a
"," forall a. a -> [a] -> [a]
: [a] -> [a]
commas [a]
xs
    commas [] = []

-- ** hs

hsBinaryRule :: InferConfig -> HsBinary -> Shake.Rules ()
hsBinaryRule :: InferConfig -> HsBinary -> Rules ()
hsBinaryRule InferConfig
infer HsBinary
binary = [Char] -> [Char] -> Bool
matchBuildDir (HsBinary -> [Char]
hsName HsBinary
binary) Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
fn -> do
    let config :: Config
config = InferConfig
infer [Char]
fn
    [Char]
hs <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO forall a b. (a -> b) -> a -> b
$ [Char]
"no main module for " forall a. [a] -> [a] -> [a]
++ [Char]
fn) forall (m :: * -> *) a. Monad m => a -> m a
return
        (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ([Char] -> [Char]
FilePath.takeFileName [Char]
fn) Map [Char] [Char]
nameToMain)
    Config -> [[Char]] -> [[Char]] -> [Char] -> [Char] -> Action ()
buildHs Config
config (HsBinary -> [[Char]]
hsRtsFlags HsBinary
binary) (forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char]
oDir Config
config </>) (HsBinary -> [[Char]]
hsDeps HsBinary
binary))
        [Char]
hs [Char]
fn
    case HsBinary -> GuiType
hsGui HsBinary
binary of
        GuiType
NoGui -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        GuiType
MakeBundle -> Bool -> [Char] -> Action ()
makeBundle Bool
False [Char]
fn
        GuiType
HasIcon -> Bool -> [Char] -> Action ()
makeBundle Bool
True [Char]
fn

-- | Build a haskell binary.
buildHs :: Config -> [Flag] -> [FilePath] -> FilePath -> FilePath
    -> Shake.Action ()
buildHs :: Config -> [[Char]] -> [[Char]] -> [Char] -> [Char] -> Action ()
buildHs Config
config [[Char]]
rtsFlags [[Char]]
libs [Char]
hs [Char]
fn = do
    -- Actually I only need it if this binary imports a module that uses
    -- hsconfig.h, but it's cheap to generate so lets always do it.
    Partial => [[Char]] -> Action ()
need [Config -> [Char]
hsconfigPath Config
config]
    [[Char]]
srcs <- Generated
-> ([Char] -> Maybe [[Char]]) -> [Char] -> Action [[Char]]
HsDeps.transitiveImportsOf Generated
generatedSrc (Config -> [Char] -> Maybe [[Char]]
cppFlags Config
config) [Char]
hs
    let ccs :: [[Char]]
ccs = forall a. Eq a => [a] -> [a]
List.nub forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] [Char]
src Map [Char] [[Char]]
hsToCc | [Char]
src <- [[Char]]
srcs]
        objs :: [[Char]]
objs = forall a. Eq a => [a] -> [a]
List.nub (forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char] -> [Char]
srcToObj Config
config) ([[Char]]
ccs forall a. [a] -> [a] -> [a]
++ [[Char]]
srcs)) forall a. [a] -> [a] -> [a]
++ [[Char]]
libs
    Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
"build" [Char]
fn [[Char]]
objs
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> [Char] -> [Char] -> [[Char]] -> Cmdline
linkHs Config
config [[Char]]
rtsFlags [Char]
fn [Char]
hs [[Char]]
objs

data BundleType = APPL | BNDL
    deriving (Int -> BundleType -> [Char] -> [Char]
[BundleType] -> [Char] -> [Char]
BundleType -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [BundleType] -> [Char] -> [Char]
$cshowList :: [BundleType] -> [Char] -> [Char]
show :: BundleType -> [Char]
$cshow :: BundleType -> [Char]
showsPrec :: Int -> BundleType -> [Char] -> [Char]
$cshowsPrec :: Int -> BundleType -> [Char] -> [Char]
Show)

makeBundle :: Bool -> FilePath -> Shake.Action ()
makeBundle :: Bool -> [Char] -> Action ()
makeBundle = Bool -> BundleType -> Bool -> [Char] -> Action ()
makeBundle_ Bool
True BundleType
APPL

makeBundle_ :: Bool -> BundleType -> Bool -> FilePath -> Shake.Action ()
makeBundle_ :: Bool -> BundleType -> Bool -> [Char] -> Action ()
makeBundle_ Bool
makeWrapper BundleType
bundleType Bool
hasIcon [Char]
binary = case Platform
Util.platform of
    Platform
Util.Mac -> do
        let icon :: [Char]
icon = [Char]
build [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
nameExt [Char]
binary [Char]
"icns"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasIcon forall a b. (a -> b) -> a -> b
$ Partial => [[Char]] -> Action ()
need [[Char]
icon]
        [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/make_bundle.py" forall a b. (a -> b) -> a -> b
$
            [[Char]
"--icon=" forall a. Semigroup a => a -> a -> a
<> [Char]
icon | Bool
hasIcon] forall a. [a] -> [a] -> [a]
++
            [[Char]
"--make-wrapper" | Bool
makeWrapper] forall a. [a] -> [a] -> [a]
++
            [ [Char]
"--type=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show BundleType
bundleType
            , [Char]
binary
            ]
    Platform
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * tests and profiles

-- | Generate RunTests.hs and compile it.
testRules :: Config -> Shake.Rules ()
testRules :: Config -> Rules ()
testRules Config
config = do
    [Char]
runTests forall a. [a] -> [a] -> [a]
++ [Char]
"*.hs" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> [Char] -> [Char] -> Action ()
generateTestHs [Char]
"_test"
    [Char] -> [Char] -> Bool
runTestsBinary [Char]
runTests Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
fn -> do
        -- The UI tests use fltk.a.  It would be nicer to have it
        -- automatically added when any .o that uses it is linked in.
        Config -> [[Char]] -> [[Char]] -> [Char] -> [Char] -> Action ()
buildHs Config
config [[Char]]
defaultRtsFlags [Config -> [Char]
oDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"fltk/fltk.a"]
            ([Char]
fn forall a. [a] -> [a] -> [a]
++ [Char]
".hs") [Char]
fn
        -- A stale .tix file from a previous compile will cause any binary to
        -- instantly crash, and there's no way to turn off .tix generation.
        [Char] -> [[Char]] -> Action ()
Util.system [Char]
"rm" [[Char]
"-f", [Char] -> [Char]
FilePath.takeFileName [Char]
fn forall a. [a] -> [a] -> [a]
++ [Char]
".tix"]

profileRules :: Config -> Shake.Rules ()
profileRules :: Config -> Rules ()
profileRules Config
config = do
    [Char]
runProfile forall a. [a] -> [a] -> [a]
++ [Char]
"*.hs" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> [Char] -> [Char] -> Action ()
generateTestHs [Char]
"_profile"
    [Char] -> [Char] -> Bool
runTestsBinary [Char]
runProfile Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
fn ->
        Config -> [[Char]] -> [[Char]] -> [Char] -> [Char] -> Action ()
buildHs Config
config [[Char]]
defaultRtsFlags [Config -> [Char]
oDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"fltk/fltk.a"]
            ([Char]
fn forall a. [a] -> [a] -> [a]
++ [Char]
".hs") [Char]
fn

-- | Match Run(Tests|Profile)(-A.B)?.hs
--
-- TODO This is hacky because I need to match the binary, but not the generated
-- output.  It's because this is the one place where the source file and
-- outputs live in the same directory.  It would be better to put the generated
-- source in build/generated or something as I do with hsc and chs.
runTestsBinary :: FilePath -> FilePath -> Bool
runTestsBinary :: [Char] -> [Char] -> Bool
runTestsBinary [Char]
prefix [Char]
fn = [Char]
prefix forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn
    Bool -> Bool -> Bool
&& [Char] -> [Char]
FilePath.takeExtension [Char]
fn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
".hs", [Char]
".o", [Char]
".hi"]

generateTestHs :: FilePath -> FilePath -> Shake.Action ()
generateTestHs :: [Char] -> [Char] -> Action ()
generateTestHs [Char]
suffix [Char]
fn = do
    -- build/test/RunTests-A.B.Xyz.hs -> A/B/Xyz_test.hs
    let testName :: [Char]
testName = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'-') forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
FilePath.dropExtension [Char]
fn
    [[Char]]
tests <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
testName
        then forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
wantsTest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Action [[Char]]
Util.findHs (Char
'*' forall a. a -> [a] -> [a]
: [Char]
suffix forall a. [a] -> [a] -> [a]
++ [Char]
".hs") [Char]
"."
        else forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> [Char]
moduleToPath [Char]
testName forall a. [a] -> [a] -> [a]
++ [Char]
suffix forall a. [a] -> [a] -> [a]
++ [Char]
".hs"]
    let generate :: [Char]
generate = Mode -> [Char]
modeToDir Mode
Opt [Char] -> [Char] -> [Char]
</> [Char]
"generate_run_tests"
    Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ [Char]
generate forall a. a -> [a] -> [a]
: [[Char]]
tests
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
generate ([Char]
fn forall a. a -> [a] -> [a]
: [[Char]]
tests)

wantsTest :: FilePath -> Bool
wantsTest :: [Char] -> Bool
wantsTest [Char]
_hs = Bool
True

-- | Build build/(mode)/RunCriterion-A.B.C from A/B/C_criterion.hs
criterionRules :: Config -> Shake.Rules ()
criterionRules :: Config -> Rules ()
criterionRules Config
config = Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"RunCriterion-*" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
fn -> do
    let hs :: [Char]
hs = Config -> [Char] -> [Char]
runCriterionToSrc Config
config [Char]
fn
    Partial => [[Char]] -> Action ()
need [[Char]
hs]
    Config -> [[Char]] -> [[Char]] -> [Char] -> [Char] -> Action ()
buildHs Config
config [[Char]]
defaultRtsFlags [] [Char]
hs [Char]
fn

-- | build/(mode)/RunCriterion-Derive.Derive -> Derive/Derive_criterion.hs
runCriterionToSrc :: Config -> FilePath -> FilePath
runCriterionToSrc :: Config -> [Char] -> [Char]
runCriterionToSrc Config
config [Char]
bin = [Char] -> [Char]
moduleToPath [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
criterionHsSuffix
    where
    -- build/(mode)/RunCriterion-Derive.Derive -> Derive.Derive
    name :: [Char]
name = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'-') forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
dropDir (Config -> [Char]
buildDir Config
config) [Char]
bin

-- | Derive/Derive_criterion.hs -> build/(mode)/RunCriterion-Derive.Derive
srcToRunCriterion :: Config -> FilePath -> FilePath
srcToRunCriterion :: Config -> [Char] -> [Char]
srcToRunCriterion Config
config [Char]
src =
    case [Char] -> [Char] -> Maybe [Char]
dropSuffix ([Char] -> [Char]
pathToModule [Char]
src) [Char]
suffix of
        Just [Char]
m -> Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"RunCriterion-" forall a. Semigroup a => a -> a -> a
<> [Char]
m
        Maybe [Char]
Nothing -> forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
            [Char]
"srcToRunCriterion: expected " forall a. Semigroup a => a -> a -> a
<> [Char]
suffix forall a. Semigroup a => a -> a -> a
<> [Char]
" suffix: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
src
    where suffix :: [Char]
suffix = [Char] -> [Char]
dropExtension [Char]
criterionHsSuffix

-- | Find targets for all criterion benchmarks.
getCriterionTargets :: Config -> Shake.Action [FilePath]
getCriterionTargets :: Config -> Action [[Char]]
getCriterionTargets Config
config =
    forall a b. (a -> b) -> [a] -> [b]
map (Config -> [Char] -> [Char]
srcToRunCriterion Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Action [[Char]]
Util.findHs (Char
'*' forall a. a -> [a] -> [a]
: [Char]
criterionHsSuffix) [Char]
"."

-- * generated haskell

generateKorvais :: Shake.Rules ()
generateKorvais :: Rules ()
generateKorvais = [Char]
generatedKorvais Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
_ -> do
    [[Char]]
inputs <- [Char] -> [[Char]] -> Action [[Char]]
Shake.getDirectoryFiles [Char]
"" [[Char]
"Solkattu/Score/*.hs"]
    let generate :: [Char]
generate = Mode -> [Char]
modeToDir Mode
Opt [Char] -> [Char] -> [Char]
</> [Char]
"extract_korvais"
    Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ [Char]
generate forall a. a -> [a] -> [a]
: [[Char]]
inputs
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
generate ([Char]
generatedKorvais forall a. a -> [a] -> [a]
: [[Char]]
inputs)

generatedKorvais :: FilePath
generatedKorvais :: [Char]
generatedKorvais = [Char]
"Solkattu/All.hs"

-- * faust

faustDspDir :: FilePath
faustDspDir :: [Char]
faustDspDir = [Char]
"Synth/Faust/dsp"

faustSrcDir :: FilePath
faustSrcDir :: [Char]
faustSrcDir = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"faust"

faustCppDir :: FilePath
faustCppDir :: [Char]
faustCppDir = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"faust-cpp"

faustRules :: Shake.Rules ()
faustRules :: Rules ()
faustRules = Rules ()
faustRule forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Rules ()
faustCppRule forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Rules ()
faustAllRule

faustCppRule :: Shake.Rules ()
faustCppRule :: Rules ()
faustCppRule = [Char]
faustCppDir [Char] -> [Char] -> [Char]
</> [Char]
"*.dsp" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
output -> do
    -- build/faust-cpp/x.dsp -> Synth/Faust/dsp/x.dsp
    let input :: [Char]
input = [Char]
faustDspDir [Char] -> [Char] -> [Char]
</> [Char] -> [Char]
FilePath.takeFileName [Char]
output
    ([[Char]]
includes, [[Char]]
notFound) <- Generated -> [[Char]] -> [Char] -> Action ([[Char]], [[Char]])
CcDeps.transitiveIncludesOf forall a. Monoid a => a
mempty [] [Char]
input
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
notFound) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO forall a b. (a -> b) -> a -> b
$ [Char]
".dsp includes not found: " forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unwords [[Char]]
notFound
    Partial => [[Char]] -> Action ()
need forall a b. (a -> b) -> a -> b
$ [Char]
input forall a. a -> [a] -> [a]
: [[Char]]
includes
    Cmdline -> Action ()
Util.cmdline
        ( [Char]
"CPP"
        , [Char]
output
        , [[Char]
"cpphs", [Char]
"--noline", [Char]
"-O" forall a. Semigroup a => a -> a -> a
<> [Char]
output, [Char]
input]
        )

faustRule :: Shake.Rules ()
faustRule :: Rules ()
faustRule = [Char]
faustSrcDir [Char] -> [Char] -> [Char]
</> [Char]
"*.cc" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
output -> do
    -- build/faust/x.cc -> build/faust-cpp/x.dsp
    let input :: [Char]
input = [Char]
faustCppDir [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
nameExt [Char]
output [Char]
".dsp"
    Partial => [[Char]] -> Action ()
need [[Char]
input]
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Cmdline
faustCmdline [Char]
input [Char]
output
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/clear_faust" [[Char] -> [Char]
dspToName [Char]
input]

faustCmdline :: FilePath -> FilePath -> Util.Cmdline
faustCmdline :: [Char] -> [Char] -> Cmdline
faustCmdline [Char]
input [Char]
output =
    ( [Char]
"FAUST"
    , [Char]
output
    , [[Char]
"faust", [Char]
input
      , [Char]
"--class-name", [Char]
"__faust_" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
dspToName [Char]
input
      , [Char]
"-lang", [Char]
"c"
      , [Char]
"-o", [Char]
output
      ]
    )

dspToName :: FilePath -> String
dspToName :: [Char] -> [Char]
dspToName = [Char] -> [Char]
FilePath.dropExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.takeFileName

-- | Synth/Faust/dsp/x.dsp -> build/faust/x.cc
dspToSrc :: FilePath -> FilePath
dspToSrc :: [Char] -> [Char]
dspToSrc [Char]
dsp = [Char]
faustSrcDir [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
nameExt [Char]
dsp [Char]
".cc"

faustAllRule :: Shake.Rules ()
faustAllRule :: Rules ()
faustAllRule = [Char]
generatedFaustAll Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
output -> do
    [[Char]]
dsps <- [Char] -> [[Char]] -> Action [[Char]]
Shake.getDirectoryFiles [Char]
"" [[Char]
faustDspDir [Char] -> [Char] -> [Char]
</> [Char]
"*.dsp"]
    let include :: [Char]
include = [Char]
"Synth/Faust/Patch.h"
    [Char] -> [Char] -> [[Char]] -> Action ()
logDepsGeneric [Char]
"faust-all" [Char]
output forall a b. (a -> b) -> a -> b
$ [Char]
include forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
dspToSrc [[Char]]
dsps
    forall (m :: * -> *).
(MonadIO m, Partial) =>
[Char] -> [Char] -> m ()
Shake.writeFileChanged [Char]
output forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]] -> [Char]
faustAll [[Char]]
dsps [[Char]
include]

-- | This is in build instead of build/faust because that makes it simpler to
-- just say build/faust/*.cc is generated by faust.
generatedFaustAll :: FilePath
generatedFaustAll :: [Char]
generatedFaustAll = [Char]
build [Char] -> [Char] -> [Char]
</> [Char]
"faust_all.cc"

faustAll :: [FilePath] -> [FilePath] -> String
faustAll :: [[Char]] -> [[Char]] -> [Char]
faustAll [[Char]]
dsps [[Char]]
extraIncludes = [[Char]] -> [Char]
unlines
    -- For some reason faust assumes these are global.
    [ [Char]
"#include <algorithm>"
    -- Even though it's a GCC pragma, clang seems to understand it too:
    -- https://clang.llvm.org/docs/UsersManual.html#pragma-gcc-diagnostic
    , [Char]
"#pragma GCC diagnostic ignored \"-Wunused-variable\""
    , [Char]
""
    , [Char]
"// faust expects these to be in scope for whatever reason"
    , [Char]
"using std::min;"
    , [Char]
"using std::max;"
    , [Char]
""
    , [[Char]] -> [Char]
unlines (forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"#include "<>) [[Char]]
includes)
    , [Char]
"static const int all_patches_count = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
names) forall a. Semigroup a => a -> a -> a
<> [Char]
";"
    , [Char]
""
    , [Char]
"static const Patch *all_patches[] ="
    , [Char]
"    { " forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => a -> [a] -> a
Lists.join [Char]
"\n    , "
        [ [Char]
"new Patch(" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => a -> [a] -> a
Lists.join [Char]
",\n        "
            [ forall a. Show a => a -> [Char]
show [Char]
name
            , [Char]
"sizeof(" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
")"
            , [Char]
"getNumInputs" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"(nullptr)"
            , [Char]
"getNumOutputs" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"(nullptr)"
            -- The casts make it unsafe, but the function takes some dsp
            -- struct, while Patch.h declares it as State *.
            , [Char]
"(Patch::Initialize) init" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name
            , [Char]
"metadata" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name
            , [Char]
"(Patch::UiMetadata) buildUserInterface" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name
            , [Char]
"(Patch::Compute) compute" forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
struct [Char]
name
            ]
            forall a. Semigroup a => a -> a -> a
<> [Char]
")"
        | [Char]
name <- [[Char]]
names
        ]

    , [Char]
"    };"
    ]
    where
    struct :: [Char] -> [Char]
struct = ([Char]
"__faust_"<>)
    names :: [[Char]]
names = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
dspToName [[Char]]
dsps
    includes :: [[Char]]
includes = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dspToSrc) [[Char]]
dsps forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [[Char]]
extraIncludes

-- * markdown

markdownRule :: FilePath -> Shake.Rules ()
markdownRule :: [Char] -> Rules ()
markdownRule [Char]
linkifyBin = [Char]
buildDocDir [Char] -> [Char] -> [Char]
</> [Char]
"*.md.html" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
html -> do
    let doc :: [Char]
doc = [Char] -> [Char]
htmlToDoc [Char]
html
    Partial => [[Char]] -> Action ()
need [[Char]
linkifyBin, [Char]
doc]
    [Char] -> [[Char]] -> Action ()
Util.system [Char]
"tools/convert_doc" [[Char]
doc, [Char]
html] -- wrapper around pandoc

-- | build/doc/xyz.md.html -> doc/xyz.md
htmlToDoc :: FilePath -> FilePath
htmlToDoc :: [Char] -> [Char]
htmlToDoc = ([Char]
docDir </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.dropExtension

-- | doc/xyz.md -> build/doc/xyz.md.html
docToHtml :: FilePath -> FilePath
docToHtml :: [Char] -> [Char]
docToHtml = ([Char]
buildDocDir </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++[Char]
".html")

-- * hs

-- hsORule hsHiRule
hsOHiRule :: InferConfig -> Shake.Rules ()
hsOHiRule :: InferConfig -> Rules ()
hsOHiRule InferConfig
infer = [Char] -> Maybe [[Char]]
matchHsObjHi Partial =>
([Char] -> Maybe [[Char]]) -> ([[Char]] -> Action ()) -> Rules ()
&?> \[[Char]]
fns -> do
    let Just [Char]
obj = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ([Char]
".hs.o" `List.isSuffixOf`) [[Char]]
fns
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
Shake.askOracle (forall {k} (a :: k). () -> Question a
Question () :: Question GhcQ)
    let config :: Config
config = InferConfig
infer [Char]
obj
    Bool
isHsc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
Directory.doesFileExist (Config -> [Char] -> [Char]
objToHsc Config
config [Char]
obj)
    Bool
isChs <- if Bool
isHsc then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        [Char] -> IO Bool
Directory.doesFileExist (Config -> [Char] -> [Char]
objToChs Config
config [Char]
obj)
    let hs :: [Char]
hs  | Bool
isHsc = Config -> [Char] -> [Char]
objToHscHs Config
config [Char]
obj
            | Bool
isChs = Config -> [Char] -> [Char]
objToChsHs Config
config [Char]
obj
            | Bool
otherwise = Config -> [Char] -> [Char]
objToSrc Config
config [Char]
obj
    [[Char]]
imports <- Generated -> Maybe [[Char]] -> [Char] -> Action [[Char]]
HsDeps.importsOf Generated
generatedSrc (Config -> [Char] -> Maybe [[Char]]
cppFlags Config
config [Char]
hs) [Char]
hs
    -- TODO no config.h?  what about hsconfig.h?

    [[Char]]
includes <- if forall a. Maybe a -> Bool
Maybe.isJust (Config -> [Char] -> Maybe [[Char]]
cppFlags Config
config [Char]
hs)
        then [Char] -> Config -> [[Char]] -> [Char] -> Action [[Char]]
includesOf [Char]
"hsOHiRule" Config
config [] [Char]
hs else forall (m :: * -> *) a. Monad m => a -> m a
return []
    let his :: [[Char]]
his = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
objToHi forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [Char] -> [Char]
srcToObj Config
config) [[Char]]
imports
    -- I depend on the .hi files instead of the .hs.o files.  GHC avoids
    -- updaing the timestamp on the .hi file if its .o didn't need to be
    -- recompiled, so hopefully this will avoid some work.
    Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
"*.hs.o *.hi" [Char]
obj ([Char]
hs forall a. a -> [a] -> [a]
: [[Char]]
includes forall a. [a] -> [a] -> [a]
++ [[Char]]
his)
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ Config -> [Char] -> Cmdline
compileHs Config
config [Char]
hs

objToHsc :: Config -> FilePath -> FilePath
objToHsc :: Config -> [Char] -> [Char]
objToHsc Config
config [Char]
obj = Config -> [Char] -> [Char]
objToSrc Config
config [Char]
obj forall a. [a] -> [a] -> [a]
++ [Char]
"c"

objToChs :: Config -> FilePath -> FilePath
objToChs :: Config -> [Char] -> [Char]
objToChs Config
config [Char]
obj = [Char] -> [Char] -> [Char]
FilePath.replaceExtension (Config -> [Char] -> [Char]
objToSrc Config
config [Char]
obj) [Char]
"chs"

-- | Generate both .hs.o and .hi from a .hs file.
matchHsObjHi :: FilePath -> Maybe [FilePath]
matchHsObjHi :: [Char] -> Maybe [[Char]]
matchHsObjHi [Char]
fn
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
fn) [[Char]
".hs.o", [Char]
".hi"]
            Bool -> Bool -> Bool
&& [Char]
"build/" forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn =
        if Bool
isMain then forall a. a -> Maybe a
Just [[Char]
suffixless forall a. [a] -> [a] -> [a]
++ [Char]
".hs.o"]
            else forall a. a -> Maybe a
Just [[Char]
suffixless forall a. [a] -> [a] -> [a]
++ [Char]
".hs.o", [Char]
suffixless forall a. [a] -> [a] -> [a]
++ [Char]
".hi"]
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
    suffixless :: [Char]
suffixless = [Char] -> [Char]
dropExtension [Char]
fn
    hs :: [Char]
hs = [Char]
suffixless forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
    -- Hack: main modules are sometimes called Main, so their .hi file doesn't
    -- have the same name as the module.  But no one should be importing them,
    -- so I don't need to track the .hi.
    isMain :: Bool
isMain = forall k a. Ord k => k -> Map k a -> Bool
Map.member [Char]
hs Map [Char] [Char]
nameToMain
        Bool -> Bool -> Bool
|| [Char]
runProfile forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
hs Bool -> Bool -> Bool
|| [Char]
runTests forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
hs
        Bool -> Bool -> Bool
|| [Char]
criterionHsSuffix forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs

compileHs :: Config -> FilePath -> Util.Cmdline
compileHs :: Config -> [Char] -> Cmdline
compileHs Config
config [Char]
hs =
    ( [Char]
"GHC " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Config -> Mode
buildMode Config
config)
    , [Char]
hs
    -- color=always since I'll be reading the output via pipe.
    , [Char]
ghcBinary forall a. a -> [a] -> [a]
: [Char]
"-c" forall a. a -> [a] -> [a]
: [Char]
"-fdiagnostics-color=always" forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Config -> [[Char]]
ghcFlags Config
config, Flags -> [[Char]]
hcFlags (Config -> Flags
configFlags Config
config)
        , Flags -> Maybe [Char] -> [[Char]]
packageFlags (Config -> Flags
configFlags Config
config) (forall a. a -> Maybe a
Just [Char]
hs)
        , [[Char]]
mainIs
        , [[Char]
hs, [Char]
"-o", Config -> [Char] -> [Char]
srcToObj Config
config [Char]
hs]
        ]
    )
    where
    mainIs :: [[Char]]
mainIs
        | [Char]
hs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall k a. Map k a -> [a]
Map.elems Map [Char] [Char]
nameToMain
                Bool -> Bool -> Bool
|| [Char]
criterionHsSuffix forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
hs =
            [[Char]
"-main-is", [Char] -> [Char]
pathToModule [Char]
hs]
        | Bool
otherwise = []

linkHs :: Config -> [Flag] -> FilePath -> FilePath -> [FilePath]
    -> Util.Cmdline
linkHs :: Config -> [[Char]] -> [Char] -> [Char] -> [[Char]] -> Cmdline
linkHs Config
config [[Char]]
rtsFlags [Char]
output [Char]
hs [[Char]]
objs =
    ( [Char]
"LD-HS"
    , [Char]
output
    , [Char]
ghcBinary forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Flags -> [[Char]]
midiLd Flags
flags
        , Flags -> [[Char]]
hLinkFlags Flags
flags
        , [[Char]
"-with-rtsopts=" forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unwords [[Char]]
rtsFlags | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
rtsFlags)]
        , [[Char]
"-lstdc++"]
        , Flags -> Maybe [Char] -> [[Char]]
packageFlags Flags
flags (forall a. a -> Maybe a
Just [Char]
hs)
        , [[Char]]
objs
        -- Suppress "warning: text-based stub file" after OSX command line
        -- tools update.
        , Config -> [[Char]]
macLinkHack Config
config
        -- Libs have to go last, or traditional unix ld can't see them.
        -- TODO: this means all binaries link fltk, not just who use it.
        -- In fact all the binaries link all the C libs.  I need the shakefile
        -- refactor to fix this.
        , ExternalLibrary -> [[Char]]
C.libLink (CLibs -> ExternalLibrary
_libfltk (Config -> CLibs
cLibs Config
config))
        , ExternalLibrary -> [[Char]]
C.libLink ExternalLibrary
libsamplerate
        , ExternalLibrary -> [[Char]]
C.libLink (Config -> ExternalLibrary
Config.rubberband Config
localConfig)
        , [[Char]
"-o", [Char]
output]
        ]
    )
    where
    flags :: Flags
flags = Config -> Flags
configFlags Config
config

-- TODO: add a writeIfChanged for these.  Not that it matters for builds, but
-- it seems silly to keep overwriting the file with the same contents.

-- | ghci has to be called with the same flags that the .o files were compiled
-- with or it won't load them.
writeGhciFlags :: (Mode -> Config) -> IO ()
writeGhciFlags :: (Mode -> Config) -> IO ()
writeGhciFlags Mode -> Config
modeConfig =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map Mode -> Config
modeConfig [Mode]
allModes) forall a b. (a -> b) -> a -> b
$ \Config
config -> do
        Bool -> [Char] -> IO ()
Directory.createDirectoryIfMissing Bool
True (Config -> [Char]
buildDir Config
config)
        [Char] -> [Char] -> IO ()
writeFile (Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"ghci-flags") forall a b. (a -> b) -> a -> b
$
            [[Char]] -> [Char]
unlines (Config -> [[Char]]
ghciFlags Config
config)

-- | Write the deps files, which are like cabal files but easier to parse.
-- Used by the nix build.
writeDeps :: FilePath -> [Package] -> IO ()
writeDeps :: [Char] -> [[Char]] -> IO ()
writeDeps [Char]
fname = [Char] -> [Char] -> IO ()
writeFile [Char]
fname forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
List.sort

-- | Make links to large binary files I don't want to put into source control.
makeDataLinks :: IO ()
makeDataLinks :: IO ()
makeDataLinks = do
    Bool -> [Char] -> IO ()
Directory.createDirectoryIfMissing Bool
True [Char]
buildDocDir
    forall {a}. IO a -> IO (Maybe a)
run forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
Posix.createSymbolicLink [Char]
"../../../data/www" ([Char]
buildDocDir [Char] -> [Char] -> [Char]
</> [Char]
"data")
    forall {a}. IO a -> IO (Maybe a)
run forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
Posix.createSymbolicLink [Char]
"../../doc/img" ([Char]
buildDocDir [Char] -> [Char] -> [Char]
</> [Char]
"img")
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where run :: IO a -> IO (Maybe a)
run = forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
Exceptions.ignoreError IOError -> Bool
IO.Error.isAlreadyExistsError

-- | Get the file-independent flags for a haskell compile.  This is disjunct
-- from 'hcFlags', which is the per-file compile-specific ones.
ghcFlags :: Config -> [Flag]
ghcFlags :: Config -> [[Char]]
ghcFlags Config
config = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
    [ [Char]
"-outputdir", Config -> [Char]
oDir Config
config, [Char]
"-osuf", [Char]
".hs.o"
    , [Char]
"-fwrite-ide-info", [Char]
"-hiedir", Config -> [Char]
buildDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"hie"
    , [Char]
"-i" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
":" [Config -> [Char]
oDir Config
config, Config -> [Char]
hscDir Config
config, Config -> [Char]
chsDir Config
config]
    ] forall a. a -> [a] -> [a]
:
    [ [[Char]]
ghcGlobalFlags
    , Flags -> [[Char]]
define (Config -> Flags
configFlags Config
config)
    , Flags -> [[Char]]
cInclude (Config -> Flags
configFlags Config
config)
    , Config -> [[Char]]
ghcWarnings Config
config
    ]

-- | Blend the delicate mix of flags needed to convince ghci to load .o files
-- that ghc just produced.
ghciFlags :: Config -> [Flag]
ghciFlags :: Config -> [[Char]]
ghciFlags Config
config = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
wanted forall a b. (a -> b) -> a -> b
$ Flags -> [[Char]]
hcFlags (Config -> Flags
configFlags Config
config)
    , Config -> [[Char]]
ghcFlags Config
config
    -- Without this, GHC API won't load compiled modules.
    -- See https://ghc.haskell.org/trac/ghc/ticket/13604
    , if | (Int, Int, Int)
version forall a. Ord a => a -> a -> Bool
<= (Int
8, Int
0, Int
2) -> []
         -- This is unpleasant, but better than having a broken REPL.
         | (Int, Int, Int)
version forall a. Ord a => a -> a -> Bool
< (Int
8, Int
4, Int
1) -> forall a. Partial => [Char] -> a
error
            [Char]
"ghc 8.2 doesn't support the flags needed to make the REPL work,\
            \ use 8.0 or 8.4, see doc/INSTALL.md for details"
         | Bool
otherwise -> [[Char]
"-fignore-optim-changes", [Char]
"-fignore-hpc-changes"]
    , Config -> [[Char]]
macLinkHack Config
config
    , Flags -> Maybe [Char] -> [[Char]]
packageFlags (Config -> Flags
configFlags Config
config) forall a. Maybe a
Nothing
    ]
    where
    version :: (Int, Int, Int)
version = Config -> (Int, Int, Int)
ghcVersion Config
config
    wanted :: [Char] -> Bool
wanted [Char]
flag = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
or
        -- Otherwise GHC API warns "-O conflicts with --interactive; -O ignored"
        [ [Char]
"-O" forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
flag
        -- Otherwise ghci warns "Hpc can't be used with byte-code interpreter."
        , [Char]
flag forall a. Eq a => a -> a -> Bool
== [Char]
"-fhpc"
        ]

-- | Suppress "warning: text-based stub file" after OSX command line tools
-- update.  Presumably this will go away when I upgrade past 10.13.
macLinkHack :: Config -> [Flag]
macLinkHack :: Config -> [[Char]]
macLinkHack Config
config
    | [Char]
"clang-1000.10.44" forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` Config -> [Char]
ccVersion Config
config = [[Char]
"-optl", [Char]
"-w"]
    | Bool
otherwise = []

-- * cc

cBinaryRule :: InferConfig -> C.Binary Config -> Shake.Rules ()
cBinaryRule :: InferConfig -> Binary Config -> Rules ()
cBinaryRule InferConfig
infer Binary Config
binary = [Char] -> [Char] -> Bool
matchBuildDir (forall config. Binary config -> [Char]
C.binName Binary Config
binary) Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
fn -> do
    let config :: Config
config = InferConfig
infer [Char]
fn
    let objs :: [[Char]]
objs = forall config. Config -> Binary config -> [[Char]]
ccDeps Config
config Binary Config
binary
    Partial => [[Char]] -> Action ()
need [[Char]]
objs
    let flags :: [[Char]]
flags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ Flags -> [[Char]]
cLibDirs (Config -> Flags
configFlags Config
config)
            , forall config. Binary config -> config -> [[Char]]
C.binCompileFlags Binary Config
binary Config
config
            , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-F"<>) (Config -> [[Char]]
Config.extraFrameworkPaths Config
localConfig)
            , forall config. Binary config -> config -> [[Char]]
C.binLinkFlags Binary Config
binary Config
config
            ]
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char] -> [[Char]] -> Cmdline
linkCc [[Char]]
flags [Char]
fn [[Char]]
objs
    forall config. Binary config -> [Char] -> Action ()
C.binPostproc Binary Config
binary [Char]
fn

ccORule :: InferConfig -> Shake.Rules ()
ccORule :: InferConfig -> Rules ()
ccORule InferConfig
infer = [Char] -> [Char] -> Bool
matchObj [Char]
"**/*.cc.o" Partial => ([Char] -> Bool) -> ([Char] -> Action ()) -> Rules ()
?> \[Char]
obj -> do
    forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
Shake.askOracle (forall {k} (a :: k). () -> Question a
Question () :: Question FltkQ)
    let config :: Config
config = InferConfig
infer [Char]
obj
    let cc :: [Char]
cc = Config -> [Char] -> [Char]
objToSrc Config
config [Char]
obj
    -- The contents of 'fltkDeps' won't be in CcBinaries, so they use only the
    -- global flags.  This is a hack that only works because I only have
    -- one C++ library.  If I ever have another one I'll need a CcLibrary
    -- target.
    let flags :: [[Char]]
flags = forall a. a -> Maybe a -> a
Maybe.fromMaybe (ExternalLibrary -> [[Char]]
C.libCompile (CLibs -> ExternalLibrary
_libfltk (Config -> CLibs
cLibs Config
config))) forall a b. (a -> b) -> a -> b
$
            Config -> [Char] -> Maybe [[Char]]
findFlags Config
config [Char]
obj
        localIncludes :: [[Char]]
localIncludes = forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
"-I" `List.isPrefixOf`) [[Char]]
flags
    [[Char]]
includes <- [Char] -> Config -> [[Char]] -> [Char] -> Action [[Char]]
includesOf [Char]
"ccORule" Config
config [[Char]]
localIncludes [Char]
cc
    Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
"*.cc.o" [Char]
obj ([Char]
ccforall a. a -> [a] -> [a]
:[[Char]]
includes)
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> [Char] -> [Char] -> Cmdline
compileCc Config
config [[Char]]
flags [Char]
cc [Char]
obj

-- | Find which 'C.Binary' has the obj file in its 'C.binObjs' and get its
-- 'C.binCompileFlags'.  This assumes that each obj file only occurs in one
-- 'C.Binary'.  Another way to do this would be to create explicit rules for
-- each Mode for each source file, but I wonder if that would add to startup
-- overhead.
findFlags :: Config -> FilePath -> Maybe [Flag]
findFlags :: Config -> [Char] -> Maybe [[Char]]
findFlags Config
config [Char]
obj =
    (forall a b. (a -> b) -> a -> b
$ Config
config) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config. Binary config -> config -> [[Char]]
C.binCompileFlags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Binary Config -> Bool
find [Binary Config]
ccBinaries
    where find :: Binary Config -> Bool
find Binary Config
binary = [Char]
obj forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall config. Config -> Binary config -> [[Char]]
ccDeps Config
config Binary Config
binary

compileCc :: Config -> [Flag] -> FilePath -> FilePath -> Util.Cmdline
compileCc :: Config -> [[Char]] -> [Char] -> [Char] -> Cmdline
compileCc Config
config [[Char]]
flags [Char]
cc [Char]
obj =
    ( [Char]
"C++ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Config -> Mode
buildMode Config
config)
    , [Char]
obj
    , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        -- color=always since I'll be reading the output via pipe.
        -- This is the gcc flag, but clang understands it too.
        [ [[Char]
"c++", [Char]
"-c", [Char]
"-fdiagnostics-color=always"]
        , Flags -> [[Char]]
globalCcFlags (Config -> Flags
configFlags Config
config)
        , [[Char]]
flags
        , [[Char]
"-o", [Char]
obj, [Char]
cc]
        ]
    )

linkCc :: [Flag] -> FilePath -> [FilePath] -> Util.Cmdline
linkCc :: [[Char]] -> [Char] -> [[Char]] -> Cmdline
linkCc [[Char]]
flags [Char]
binary [[Char]]
objs =
    ( [Char]
"LD-CC"
    , [Char]
binary
    , [Char]
"c++" forall a. a -> [a] -> [a]
: [[Char]]
objs forall a. [a] -> [a] -> [a]
++ [[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
"-o", [Char]
binary]
    )

-- * hsc

hsc2hsRule :: Config -> Shake.Rules ()
hsc2hsRule :: Config -> Rules ()
hsc2hsRule Config
config = Config -> [Char]
hscDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"**/*.hs" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
hs -> do
    let hsc :: [Char]
hsc = [Char] -> [Char] -> [Char]
hsToHsc (Config -> [Char]
hscDir Config
config) [Char]
hs
    [[Char]]
includes <- [Char] -> Config -> [[Char]] -> [Char] -> Action [[Char]]
includesOf [Char]
"hsc2hsRule" Config
config [] [Char]
hsc
    Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
"*.hsc" [Char]
hs ([Char]
hsc forall a. a -> [a] -> [a]
: [[Char]]
includes)
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ Config -> [Char] -> [Char] -> Cmdline
hsc2hs Config
config [Char]
hs [Char]
hsc

hsc2hs :: Config -> FilePath -> FilePath -> Util.Cmdline
hsc2hs :: Config -> [Char] -> [Char] -> Cmdline
hsc2hs Config
config [Char]
hs [Char]
hsc =
    ( [Char]
"hsc2hs"
    , [Char]
hs
    , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Char]
"hsc2hs", [Char]
"-I" forall a. [a] -> [a] -> [a]
++ Config -> [Char]
ghcLib Config
config [Char] -> [Char] -> [Char]
</> [Char]
"include"]
        -- Otherwise g++ complains about the offsetof macro hsc2hs uses.
        , [Char] -> [[Char]]
words [Char]
"-c c++ --cflag -Wno-invalid-offsetof --cflag -std=c++11"
        -- hsc2hs comes from nix, so it does the nix magic, so
        -- cIncludeUnwrapped is not necessary.
        , Flags -> [[Char]]
cInclude Flags
flags forall a. [a] -> [a] -> [a]
++ ExternalLibrary -> [[Char]]
C.libCompile (CLibs -> ExternalLibrary
_libfltk (Config -> CLibs
cLibs Config
config))
        , Flags -> [[Char]]
define Flags
flags
        , [[Char]
hsc, [Char]
"-o", [Char]
hs]
        ]
    )
    where flags :: Flags
flags = Config -> Flags
configFlags Config
config

-- * c2hs

chsRule :: Config -> Shake.Rules ()
chsRule :: Config -> Rules ()
chsRule Config
config = Config -> [Char]
chsDir Config
config [Char] -> [Char] -> [Char]
</> [Char]
"**/*.hs" Partial => [Char] -> ([Char] -> Action ()) -> Rules ()
%> \[Char]
hs -> do
    -- TODO also produces .chi, .chs.h
    let chs :: [Char]
chs = [Char] -> [Char] -> [Char]
hsToChs (Config -> [Char]
chsDir Config
config) [Char]
hs
    [[Char]]
includes <- [Char] -> Config -> [[Char]] -> [Char] -> Action [[Char]]
includesOf [Char]
"chsRule" Config
config [] [Char]
chs
    Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
"*.chs" [Char]
hs ([Char]
chs forall a. a -> [a] -> [a]
: [[Char]]
includes)
    [[Char]]
includeFlags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Flags -> IO [[Char]]
cIncludeUnwrapped (Config -> Flags
configFlags Config
config)
    Cmdline -> Action ()
Util.cmdline forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> [Char] -> [Char] -> Cmdline
c2hs Config
config [[Char]]
includeFlags [Char]
hs [Char]
chs

c2hs :: Config -> [Flag] -> FilePath -> FilePath -> Util.Cmdline
c2hs :: Config -> [[Char]] -> [Char] -> [Char] -> Cmdline
c2hs Config
config [[Char]]
includeFlags [Char]
hs [Char]
chs =
    ( [Char]
"c2hs"
    , [Char]
hs
    , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Char]
"c2hs"]
        , forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--cppopts="<>) forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
platformDefines) (Flags -> [[Char]]
define Flags
flags)
          forall a. [a] -> [a] -> [a]
++ [[Char]]
includeFlags
        , [ [Char]
"--output-dir=" forall a. Semigroup a => a -> a -> a
<> Config -> [Char]
chsDir Config
config
          , [Char]
chs
          ]
        ]
    )
    where flags :: Flags
flags = Config -> Flags
configFlags Config
config

-- * util

-- |
-- A/B.{hs,hsc,chs} -> build/debug/obj/A/B.hs.o
-- A/B.cc -> build/debug/obj/A/B.cc.o
-- build/A/B.hs -> build/A/B.hs.o
-- build/{hsc,chs}/Ui/Key.hs -> build/debug/obj/Ui/Key.hs.o
--
-- Generated .hs files are already in build/ so they shouldn't have build/etc.
-- prepended.  Unless they were .hsc or .chs generated files.
srcToObj :: Config -> FilePath -> FilePath
srcToObj :: Config -> [Char] -> [Char]
srcToObj Config
config [Char]
fn = [Char] -> [Char]
addDir forall a b. (a -> b) -> a -> b
$ if
    | [Char]
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".hsc", [Char]
".chs"] -> [Char] -> [Char] -> [Char]
FilePath.replaceExtension [Char]
fn [Char]
"hs.o"
    | [Char]
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".hs", [Char]
".cc"] -> [Char] -> [Char] -> [Char]
FilePath.addExtension [Char]
fn [Char]
"o"
    | Bool
otherwise -> forall a. Partial => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unknown src extension: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
fn
    where
    ext :: [Char]
ext = [Char] -> [Char]
FilePath.takeExtension [Char]
fn
    addDir :: [Char] -> [Char]
addDir
        | Config -> [Char]
hscDir Config
config forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn =
            (Config -> [Char]
oDir Config
config </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
dropDir (Config -> [Char]
hscDir Config
config)
        | Config -> [Char]
chsDir Config
config forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn =
            (Config -> [Char]
oDir Config
config </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
dropDir (Config -> [Char]
chsDir Config
config)
        | [Char]
build forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn = forall a. a -> a
id
        | Bool
otherwise = (Config -> [Char]
oDir Config
config </>)

-- | build/debug/obj/A/B.$ext.o -> A/B.$ext
objToSrc :: Config -> FilePath -> FilePath
objToSrc :: Config -> [Char] -> [Char]
objToSrc Config
config = [Char] -> [Char]
FilePath.dropExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
dropDir (Config -> [Char]
oDir Config
config)

-- | build/debug/obj/A/B.o -> build/hsc/A/B.hs
objToHscHs :: Config -> FilePath -> FilePath
objToHscHs :: Config -> [Char] -> [Char]
objToHscHs Config
config = (Config -> [Char]
hscDir Config
config </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [Char] -> [Char]
objToSrc Config
config

-- | build/debug/obj/A/B.o -> build/chs/A/B.hs
objToChsHs :: Config -> FilePath -> FilePath
objToChsHs :: Config -> [Char] -> [Char]
objToChsHs Config
config = (Config -> [Char]
chsDir Config
config </>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [Char] -> [Char]
objToSrc Config
config

-- | build/hsc/A/B.hs -> A/B.hsc
hsToHsc :: FilePath -> FilePath -> FilePath
hsToHsc :: [Char] -> [Char] -> [Char]
hsToHsc [Char]
hscDir [Char]
fn = [Char] -> [Char] -> [Char]
dropDir [Char]
hscDir forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
FilePath.replaceExtension [Char]
fn [Char]
"hsc"

-- | A/B.hsc -> build/hsc/A/B.hs
hscToHs :: FilePath -> FilePath -> FilePath
hscToHs :: [Char] -> [Char] -> [Char]
hscToHs [Char]
hscDir [Char]
fn = ([Char]
hscDir </>) forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
FilePath.replaceExtension [Char]
fn [Char]
"hs"

-- | A/B.chs -> build/chs/A/B.hs
chsToHs :: FilePath -> FilePath -> FilePath
chsToHs :: [Char] -> [Char] -> [Char]
chsToHs [Char]
chsDir [Char]
fn = ([Char]
chsDir </>) forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
FilePath.replaceExtension [Char]
fn [Char]
"hs"

-- | build/chs/A/B.hs -> A/B.chs
hsToChs :: FilePath -> FilePath -> FilePath
hsToChs :: [Char] -> [Char] -> [Char]
hsToChs [Char]
chsDir [Char]
fn = [Char] -> [Char] -> [Char]
dropDir [Char]
chsDir forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
FilePath.replaceExtension [Char]
fn [Char]
"chs"

objToHi :: FilePath -> FilePath
objToHi :: [Char] -> [Char]
objToHi = (forall a. [a] -> [a] -> [a]
++[Char]
".hi") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropExtension

dropExtension :: FilePath -> FilePath
dropExtension :: [Char] -> [Char]
dropExtension [Char]
fn
    | [Char]
".hs.o" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
fn = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fn forall a. Num a => a -> a -> a
- Int
5) [Char]
fn
    | Bool
otherwise = [Char] -> [Char]
FilePath.dropExtension [Char]
fn

dropDir :: FilePath -> FilePath -> FilePath
dropDir :: [Char] -> [Char] -> [Char]
dropDir [Char]
odir [Char]
fn
    | [Char]
dir forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
fn = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
dir) [Char]
fn
    | Bool
otherwise = [Char]
fn
    where dir :: [Char]
dir = [Char]
odir forall a. [a] -> [a] -> [a]
++ [Char]
"/"

strip :: String -> String
strip :: [Char] -> [Char]
strip = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace

-- | Foor/Bar.hs -> Foo.Bar
pathToModule :: FilePath -> String
pathToModule :: [Char] -> [Char]
pathToModule = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
'.' else Char
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.dropExtension

-- | Foo.Bar -> Foo/Bar
moduleToPath :: String -> FilePath
moduleToPath :: [Char] -> [Char]
moduleToPath = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'/' else Char
c

logDeps :: Config -> String -> FilePath -> [FilePath] -> Shake.Action ()
logDeps :: Config -> [Char] -> [Char] -> [[Char]] -> Action ()
logDeps Config
config [Char]
stage [Char]
fn [[Char]]
deps
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
deps = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Partial => [[Char]] -> Action ()
need [[Char]]
deps
        [Char] -> Action ()
Shake.putLoud forall a b. (a -> b) -> a -> b
$ [Char]
">>> " forall a. [a] -> [a] -> [a]
++ [Char]
stage forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
fn forall a. [a] -> [a] -> [a]
++ [Char]
" <- "
            forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
dropDir (Config -> [Char]
oDir Config
config)) [[Char]]
deps)

-- | logDeps for Mode-independent build products.
logDepsGeneric :: String -> FilePath -> [FilePath] -> Shake.Action ()
logDepsGeneric :: [Char] -> [Char] -> [[Char]] -> Action ()
logDepsGeneric [Char]
stage [Char]
fn [[Char]]
deps
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
deps = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Partial => [[Char]] -> Action ()
need [[Char]]
deps
        [Char] -> Action ()
Shake.putLoud forall a b. (a -> b) -> a -> b
$ [Char]
">>> " forall a. [a] -> [a] -> [a]
++ [Char]
stage forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
fn forall a. [a] -> [a] -> [a]
++ [Char]
" <- " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
deps

includesOf :: String -> Config -> [Flag] -> FilePath -> Shake.Action [FilePath]
includesOf :: [Char] -> Config -> [[Char]] -> [Char] -> Action [[Char]]
includesOf [Char]
caller Config
config [[Char]]
moreIncludes [Char]
fn = do
    let dirs :: [[Char]]
dirs =
            [[Char]
dir | Char
'-':Char
'I':[Char]
dir <- Flags -> [[Char]]
cInclude (Config -> Flags
configFlags Config
config) forall a. [a] -> [a] -> [a]
++ [[Char]]
moreIncludes]
    ([[Char]]
includes, [[Char]]
notFound) <- ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
hsconfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Generated -> [[Char]] -> [Char] -> Action ([[Char]], [[Char]])
CcDeps.transitiveIncludesOf (Generated -> Generated
HsDeps._generatedHs Generated
generatedSrc) [[Char]]
dirs [Char]
fn
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
notFound) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
caller
            forall a. [a] -> [a] -> [a]
++ [Char]
": WARNING: c includes not found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
notFound
            forall a. [a] -> [a] -> [a]
++ [Char]
" (looked in " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
dirs forall a. [a] -> [a] -> [a]
++ [Char]
")"
    forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
includes
    where
    -- hsconfig.h is the only automatically generated header.  Because the
    -- #include line doesn't give the path (and can't, since each build dir
    -- has its own hsconfig.h), I have to special case it.
    hsconfig :: ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
hsconfig ([[Char]]
includes, [[Char]]
notFound)
        | [Char]
hsconfigH forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
notFound =
            (Config -> [Char]
hsconfigPath Config
config forall a. a -> [a] -> [a]
: [[Char]]
includes, forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=[Char]
hsconfigH) [[Char]]
notFound)
        | Bool
otherwise = ([[Char]]
includes, [[Char]]
notFound)

dropPrefix :: String -> String -> Maybe String
dropPrefix :: [Char] -> [Char] -> Maybe [Char]
dropPrefix [Char]
pref [Char]
str
    | [Char]
pref forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Char]
str = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
pref) [Char]
str
    | Bool
otherwise = forall a. Maybe a
Nothing

dropSuffix :: String -> String -> Maybe String
dropSuffix :: [Char] -> [Char] -> Maybe [Char]
dropSuffix [Char]
str [Char]
suf
    | [Char]
suf forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
str =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
suf) (forall a. [a] -> [a]
reverse [Char]
str)
    | Bool
otherwise = forall a. Maybe a
Nothing

nameExt :: FilePath -> String -> FilePath
nameExt :: [Char] -> [Char] -> [Char]
nameExt [Char]
fn = [Char] -> [Char] -> [Char]
FilePath.replaceExtension ([Char] -> [Char]
FilePath.takeFileName [Char]
fn)

-- NOTE [no-package] I don't have a way to declare packages and their
-- dependencies.  I just sort of ad-hoc it by giving most dependencies to
-- everyone, but it's a problem for haddock and tests, which are global.
-- A real generalized reusable package system is complicated, so for the
-- moment I hack it by filtering based on directory prefix.