module Language.Drasil.Code.Imperative.Build.AST where
import Build.Drasil (makeS, MakeString, mkImplicitVar, mkWindowsVar, mkOSVar,
  Command, mkCheckedCommand, Dependencies)

-- | Used to build commands. Type synonym of a 'MakeString' for clarity.
type CommandFragment = MakeString

-- | Type for holding the build name.
data BuildName = BMain
               | BPackName
               | BPack BuildName
               | BWithExt BuildName Ext

-- | File extentions.
data Ext = CodeExt
         | OtherExt MakeString

-- | Builds may only require themselves or have a dependency.
data BuildDependencies = BcSource
                       | BcSingle BuildName

-- | Build configuration. In the function parameter, the first parameter is the list of inputs,
-- 2nd parameter is the output file, 3rd parameter is additional name if needed.
-- The two 'Maybe' 'BuildName's are the output file and the additional name.
-- Also holds the build dependencies.
data BuildConfig = BuildConfig
  ([CommandFragment] -> CommandFragment -> CommandFragment -> [BuildCommand])
  (Maybe BuildName) (Maybe BuildName) BuildDependencies

-- | Run commands as they are or through an interpreter.
data RunType = Standalone
             | Interpreter [CommandFragment]

-- | Contains all the information needed to run a command.
data Runnable = Runnable BuildName NameOpts RunType

-- | Configures a document based on dependencies and commands.
data DocConfig = DocConfig Dependencies [Command]

-- | Naming options. Includes a package separator and an option for including extensions.
data NameOpts = NameOpts {
  NameOpts -> String
packSep :: String,
  NameOpts -> Bool
includeExt :: Bool
}

-- | Default name options. Packages separately by "/" and includes extension.
nameOpts :: NameOpts
nameOpts :: NameOpts
nameOpts = NameOpts {
  packSep :: String
packSep = String
"/",
  includeExt :: Bool
includeExt = Bool
True
}

-- | Build commands. Made up of 'CommandFragment's.
type BuildCommand = [CommandFragment]
-- | Interpreter commands are made up of a 'String'.
type InterpreterCommand = String
-- | Interpreter options are made up of a 'String'.
type InterpreterOption = String

-- | Translates a 'String' into a command fragment.
asFragment :: String -> CommandFragment
asFragment :: String -> CommandFragment
asFragment = String -> CommandFragment
makeS

-- | OS default variable (Windows). Calls 'mkWindowsVar'.
osClassDefault :: String -> String -> String -> CommandFragment
osClassDefault :: String -> String -> String -> CommandFragment
osClassDefault = String -> String -> String -> CommandFragment
mkWindowsVar

-- | Constructor for a build configuration. No additional name included.
buildAll :: ([CommandFragment] -> CommandFragment -> [BuildCommand]) ->
  BuildName -> Maybe BuildConfig
buildAll :: ([CommandFragment] -> CommandFragment -> [[CommandFragment]])
-> BuildName -> Maybe BuildConfig
buildAll [CommandFragment] -> CommandFragment -> [[CommandFragment]]
f BuildName
n = BuildConfig -> Maybe BuildConfig
forall a. a -> Maybe a
Just (BuildConfig -> Maybe BuildConfig)
-> BuildConfig -> Maybe BuildConfig
forall a b. (a -> b) -> a -> b
$ ([CommandFragment]
 -> CommandFragment -> CommandFragment -> [[CommandFragment]])
-> Maybe BuildName
-> Maybe BuildName
-> BuildDependencies
-> BuildConfig
BuildConfig (\[CommandFragment]
i CommandFragment
o CommandFragment
_ -> [CommandFragment] -> CommandFragment -> [[CommandFragment]]
f [CommandFragment]
i CommandFragment
o) (BuildName -> Maybe BuildName
forall a. a -> Maybe a
Just BuildName
n) Maybe BuildName
forall a. Maybe a
Nothing BuildDependencies
BcSource

-- | Constructor for a build configuration with an additional name included.
buildAllAdditionalName :: ([CommandFragment] -> CommandFragment ->
  CommandFragment -> [BuildCommand]) -> BuildName -> BuildName ->
  Maybe BuildConfig
buildAllAdditionalName :: ([CommandFragment]
 -> CommandFragment -> CommandFragment -> [[CommandFragment]])
-> BuildName -> BuildName -> Maybe BuildConfig
buildAllAdditionalName [CommandFragment]
-> CommandFragment -> CommandFragment -> [[CommandFragment]]
f BuildName
n BuildName
a = BuildConfig -> Maybe BuildConfig
forall a. a -> Maybe a
Just (BuildConfig -> Maybe BuildConfig)
-> BuildConfig -> Maybe BuildConfig
forall a b. (a -> b) -> a -> b
$ ([CommandFragment]
 -> CommandFragment -> CommandFragment -> [[CommandFragment]])
-> Maybe BuildName
-> Maybe BuildName
-> BuildDependencies
-> BuildConfig
BuildConfig [CommandFragment]
-> CommandFragment -> CommandFragment -> [[CommandFragment]]
f (BuildName -> Maybe BuildName
forall a. a -> Maybe a
Just BuildName
n) (BuildName -> Maybe BuildName
forall a. a -> Maybe a
Just BuildName
a) BuildDependencies
BcSource

-- | Constructor for a build configuration.
-- No additional name included, but takes in a single dependency.
buildSingle :: ([CommandFragment] -> CommandFragment -> [BuildCommand]) ->
  BuildName -> BuildName -> Maybe BuildConfig
buildSingle :: ([CommandFragment] -> CommandFragment -> [[CommandFragment]])
-> BuildName -> BuildName -> Maybe BuildConfig
buildSingle [CommandFragment] -> CommandFragment -> [[CommandFragment]]
f BuildName
n = BuildConfig -> Maybe BuildConfig
forall a. a -> Maybe a
Just (BuildConfig -> Maybe BuildConfig)
-> (BuildName -> BuildConfig) -> BuildName -> Maybe BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CommandFragment]
 -> CommandFragment -> CommandFragment -> [[CommandFragment]])
-> Maybe BuildName
-> Maybe BuildName
-> BuildDependencies
-> BuildConfig
BuildConfig (\[CommandFragment]
i CommandFragment
o CommandFragment
_ -> [CommandFragment] -> CommandFragment -> [[CommandFragment]]
f [CommandFragment]
i CommandFragment
o) (BuildName -> Maybe BuildName
forall a. a -> Maybe a
Just BuildName
n) Maybe BuildName
forall a. Maybe a
Nothing (BuildDependencies -> BuildConfig)
-> (BuildName -> BuildDependencies) -> BuildName -> BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  BuildName -> BuildDependencies
BcSingle

-- | Default runnable information.
nativeBinary :: Maybe Runnable
nativeBinary :: Maybe Runnable
nativeBinary = Runnable -> Maybe Runnable
forall a. a -> Maybe a
Just (Runnable -> Maybe Runnable) -> Runnable -> Maybe Runnable
forall a b. (a -> b) -> a -> b
$ BuildName -> NameOpts -> RunType -> Runnable
Runnable BuildName
executable NameOpts
nameOpts RunType
Standalone

-- | Default target extension is ".exe".
executable :: BuildName
executable :: BuildName
executable = BuildName -> Ext -> BuildName
BWithExt BuildName
BPackName (Ext -> BuildName) -> Ext -> BuildName
forall a b. (a -> b) -> a -> b
$ CommandFragment -> Ext
OtherExt (CommandFragment -> Ext) -> CommandFragment -> Ext
forall a b. (a -> b) -> a -> b
$
  String -> String -> String -> CommandFragment
osClassDefault String
"TARGET_EXTENSION" String
".exe" String
""

-- | Default library has the extentions ".dll, .dylib, .so".
sharedLibrary :: BuildName
sharedLibrary :: BuildName
sharedLibrary = BuildName -> Ext -> BuildName
BWithExt BuildName
BPackName (Ext -> BuildName) -> Ext -> BuildName
forall a b. (a -> b) -> a -> b
$ CommandFragment -> Ext
OtherExt (CommandFragment -> Ext) -> CommandFragment -> Ext
forall a b. (a -> b) -> a -> b
$
  String -> String -> String -> String -> CommandFragment
mkOSVar String
"LIB_EXTENSION" String
".dll" String
".dylib" String
".so"

-- | Constructor for a runnable command that goes through an interpreter.
interp :: BuildName -> NameOpts -> InterpreterCommand -> [InterpreterOption]
  -> Maybe Runnable
interp :: BuildName -> NameOpts -> String -> [String] -> Maybe Runnable
interp BuildName
b NameOpts
n String
c = Runnable -> Maybe Runnable
forall a. a -> Maybe a
Just (Runnable -> Maybe Runnable)
-> ([String] -> Runnable) -> [String] -> Maybe Runnable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildName -> NameOpts -> RunType -> Runnable
Runnable BuildName
b NameOpts
n (RunType -> Runnable)
-> ([String] -> RunType) -> [String] -> Runnable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandFragment] -> RunType
Interpreter ([CommandFragment] -> RunType)
-> ([String] -> [CommandFragment]) -> [String] -> RunType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CommandFragment) -> [String] -> [CommandFragment]
forall a b. (a -> b) -> [a] -> [b]
map String -> CommandFragment
makeS ([String] -> [CommandFragment])
-> ([String] -> [String]) -> [String] -> [CommandFragment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)

-- | Constructs a runnable command that goes through an interpreter (for main module file).
interpMM :: InterpreterCommand -> Maybe Runnable
interpMM :: String -> Maybe Runnable
interpMM = Runnable -> Maybe Runnable
forall a. a -> Maybe a
Just (Runnable -> Maybe Runnable)
-> (String -> Runnable) -> String -> Maybe Runnable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildName -> NameOpts -> RunType -> Runnable
Runnable BuildName
mainModuleFile NameOpts
nameOpts (RunType -> Runnable) -> (String -> RunType) -> String -> Runnable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandFragment] -> RunType
Interpreter ([CommandFragment] -> RunType)
-> (String -> [CommandFragment]) -> String -> RunType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandFragment -> [CommandFragment] -> [CommandFragment]
forall a. a -> [a] -> [a]
:[]) (CommandFragment -> [CommandFragment])
-> (String -> CommandFragment) -> String -> [CommandFragment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandFragment
makeS

-- | Main module.
mainModule :: BuildName
mainModule :: BuildName
mainModule = BuildName
BMain

-- | Main module with a default code extension.
mainModuleFile :: BuildName
mainModuleFile :: BuildName
mainModuleFile = BuildName -> Ext -> BuildName
BWithExt BuildName
BMain Ext
CodeExt

-- | Module for an in-code package.
inCodePackage :: BuildName -> BuildName
inCodePackage :: BuildName -> BuildName
inCodePackage = BuildName -> BuildName
BPack

-- | Adds an extension to a 'BuildName'.
withExt :: BuildName -> String -> BuildName
withExt :: BuildName -> String -> BuildName
withExt BuildName
b = BuildName -> Ext -> BuildName
BWithExt BuildName
b (Ext -> BuildName) -> (String -> Ext) -> String -> BuildName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandFragment -> Ext
OtherExt (CommandFragment -> Ext)
-> (String -> CommandFragment) -> String -> Ext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandFragment
makeS

-- | C compiler command fragment.
cCompiler :: CommandFragment
cCompiler :: CommandFragment
cCompiler = String -> CommandFragment
mkImplicitVar String
"CC"

-- | C++ compiler command fragment.
cppCompiler :: CommandFragment
cppCompiler :: CommandFragment
cppCompiler = String -> CommandFragment
mkImplicitVar String
"CXX"

-- | Helper for configuring doxygen documentation.
doxygenDocConfig :: FilePath -> DocConfig
doxygenDocConfig :: String -> DocConfig
doxygenDocConfig String
fp = [CommandFragment] -> [Command] -> DocConfig
DocConfig [String -> CommandFragment
makeS String
fp]
  [CommandFragment -> Command
mkCheckedCommand (CommandFragment -> Command) -> CommandFragment -> Command
forall a b. (a -> b) -> a -> b
$ String -> CommandFragment
makeS (String -> CommandFragment) -> String -> CommandFragment
forall a b. (a -> b) -> a -> b
$ String
"doxygen " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp]