{- -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE Safe #-}

module Cli.CompileOptions (
  CompileOptions(..),
  CompileMode(..),
  ExtraSource(..),
  ForceMode(..),
  HelpMode(..),
  emptyCompileOptions,
  getLinkFlags,
  getSourceCategories,
  getSourceDeps,
  getSourceFile,
  isCompileBinary,
  isCompileFast,
  isCompileIncremental,
  isCompileRecompile,
  isCreateTemplates,
  isExecuteTests,
  maybeDisableHelp,
) where

import Types.TypeCategory (FunctionName)
import Types.TypeInstance (CategoryName)


data CompileOptions =
  CompileOptions {
    CompileOptions -> HelpMode
coHelp :: HelpMode,
    CompileOptions -> [FilePath]
coPublicDeps :: [FilePath],
    CompileOptions -> [FilePath]
coPrivateDeps :: [FilePath],
    CompileOptions -> [FilePath]
coPaths :: [FilePath],
    CompileOptions -> [ExtraSource]
coExtraFiles :: [ExtraSource],
    CompileOptions -> [FilePath]
coExtraPaths :: [FilePath],
    CompileOptions -> FilePath
coSourcePrefix :: FilePath,
    CompileOptions -> CompileMode
coMode :: CompileMode,
    CompileOptions -> ForceMode
coForce :: ForceMode
  }
  deriving (Int -> CompileOptions -> ShowS
[CompileOptions] -> ShowS
CompileOptions -> FilePath
(Int -> CompileOptions -> ShowS)
-> (CompileOptions -> FilePath)
-> ([CompileOptions] -> ShowS)
-> Show CompileOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompileOptions] -> ShowS
$cshowList :: [CompileOptions] -> ShowS
show :: CompileOptions -> FilePath
$cshow :: CompileOptions -> FilePath
showsPrec :: Int -> CompileOptions -> ShowS
$cshowsPrec :: Int -> CompileOptions -> ShowS
Show)

emptyCompileOptions :: CompileOptions
emptyCompileOptions :: CompileOptions
emptyCompileOptions =
  CompileOptions :: HelpMode
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> FilePath
-> CompileMode
-> ForceMode
-> CompileOptions
CompileOptions {
    coHelp :: HelpMode
coHelp = HelpMode
HelpUnspecified,
    coPublicDeps :: [FilePath]
coPublicDeps = [],
    coPrivateDeps :: [FilePath]
coPrivateDeps = [],
    coPaths :: [FilePath]
coPaths = [],
    coExtraFiles :: [ExtraSource]
coExtraFiles = [],
    coExtraPaths :: [FilePath]
coExtraPaths = [],
    coSourcePrefix :: FilePath
coSourcePrefix = FilePath
"",
    coMode :: CompileMode
coMode = CompileMode
CompileUnspecified,
    coForce :: ForceMode
coForce = ForceMode
DoNotForce
  }

data ExtraSource =
  CategorySource {
    ExtraSource -> FilePath
csSource :: FilePath,
    ExtraSource -> [CategoryName]
csCategories :: [CategoryName],
    ExtraSource -> [CategoryName]
csRequires :: [CategoryName]
  } |
  OtherSource {
    ExtraSource -> FilePath
osSource :: FilePath
  }
  deriving (ExtraSource -> ExtraSource -> Bool
(ExtraSource -> ExtraSource -> Bool)
-> (ExtraSource -> ExtraSource -> Bool) -> Eq ExtraSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraSource -> ExtraSource -> Bool
$c/= :: ExtraSource -> ExtraSource -> Bool
== :: ExtraSource -> ExtraSource -> Bool
$c== :: ExtraSource -> ExtraSource -> Bool
Eq,Int -> ExtraSource -> ShowS
[ExtraSource] -> ShowS
ExtraSource -> FilePath
(Int -> ExtraSource -> ShowS)
-> (ExtraSource -> FilePath)
-> ([ExtraSource] -> ShowS)
-> Show ExtraSource
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExtraSource] -> ShowS
$cshowList :: [ExtraSource] -> ShowS
show :: ExtraSource -> FilePath
$cshow :: ExtraSource -> FilePath
showsPrec :: Int -> ExtraSource -> ShowS
$cshowsPrec :: Int -> ExtraSource -> ShowS
Show)

getSourceFile :: ExtraSource -> String
getSourceFile :: ExtraSource -> FilePath
getSourceFile (CategorySource FilePath
s [CategoryName]
_ [CategoryName]
_) = FilePath
s
getSourceFile (OtherSource FilePath
s)        = FilePath
s

getSourceCategories :: ExtraSource -> [CategoryName]
getSourceCategories :: ExtraSource -> [CategoryName]
getSourceCategories (CategorySource FilePath
_ [CategoryName]
cs [CategoryName]
_) = [CategoryName]
cs
getSourceCategories (OtherSource FilePath
_)         = []

getSourceDeps :: ExtraSource -> [CategoryName]
getSourceDeps :: ExtraSource -> [CategoryName]
getSourceDeps (CategorySource FilePath
_ [CategoryName]
_ [CategoryName]
ds) = [CategoryName]
ds
getSourceDeps (OtherSource FilePath
_)         = []

data HelpMode = HelpNeeded | HelpNotNeeded | HelpUnspecified deriving (HelpMode -> HelpMode -> Bool
(HelpMode -> HelpMode -> Bool)
-> (HelpMode -> HelpMode -> Bool) -> Eq HelpMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpMode -> HelpMode -> Bool
$c/= :: HelpMode -> HelpMode -> Bool
== :: HelpMode -> HelpMode -> Bool
$c== :: HelpMode -> HelpMode -> Bool
Eq,Int -> HelpMode -> ShowS
[HelpMode] -> ShowS
HelpMode -> FilePath
(Int -> HelpMode -> ShowS)
-> (HelpMode -> FilePath) -> ([HelpMode] -> ShowS) -> Show HelpMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HelpMode] -> ShowS
$cshowList :: [HelpMode] -> ShowS
show :: HelpMode -> FilePath
$cshow :: HelpMode -> FilePath
showsPrec :: Int -> HelpMode -> ShowS
$cshowsPrec :: Int -> HelpMode -> ShowS
Show)

data ForceMode = DoNotForce | ForceAll deriving (ForceMode -> ForceMode -> Bool
(ForceMode -> ForceMode -> Bool)
-> (ForceMode -> ForceMode -> Bool) -> Eq ForceMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForceMode -> ForceMode -> Bool
$c/= :: ForceMode -> ForceMode -> Bool
== :: ForceMode -> ForceMode -> Bool
$c== :: ForceMode -> ForceMode -> Bool
Eq,Eq ForceMode
Eq ForceMode
-> (ForceMode -> ForceMode -> Ordering)
-> (ForceMode -> ForceMode -> Bool)
-> (ForceMode -> ForceMode -> Bool)
-> (ForceMode -> ForceMode -> Bool)
-> (ForceMode -> ForceMode -> Bool)
-> (ForceMode -> ForceMode -> ForceMode)
-> (ForceMode -> ForceMode -> ForceMode)
-> Ord ForceMode
ForceMode -> ForceMode -> Bool
ForceMode -> ForceMode -> Ordering
ForceMode -> ForceMode -> ForceMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ForceMode -> ForceMode -> ForceMode
$cmin :: ForceMode -> ForceMode -> ForceMode
max :: ForceMode -> ForceMode -> ForceMode
$cmax :: ForceMode -> ForceMode -> ForceMode
>= :: ForceMode -> ForceMode -> Bool
$c>= :: ForceMode -> ForceMode -> Bool
> :: ForceMode -> ForceMode -> Bool
$c> :: ForceMode -> ForceMode -> Bool
<= :: ForceMode -> ForceMode -> Bool
$c<= :: ForceMode -> ForceMode -> Bool
< :: ForceMode -> ForceMode -> Bool
$c< :: ForceMode -> ForceMode -> Bool
compare :: ForceMode -> ForceMode -> Ordering
$ccompare :: ForceMode -> ForceMode -> Ordering
$cp1Ord :: Eq ForceMode
Ord,Int -> ForceMode -> ShowS
[ForceMode] -> ShowS
ForceMode -> FilePath
(Int -> ForceMode -> ShowS)
-> (ForceMode -> FilePath)
-> ([ForceMode] -> ShowS)
-> Show ForceMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ForceMode] -> ShowS
$cshowList :: [ForceMode] -> ShowS
show :: ForceMode -> FilePath
$cshow :: ForceMode -> FilePath
showsPrec :: Int -> ForceMode -> ShowS
$cshowsPrec :: Int -> ForceMode -> ShowS
Show)

data CompileMode =
  CompileBinary {
    CompileMode -> CategoryName
cbCategory :: CategoryName,
    CompileMode -> FunctionName
cbFunction :: FunctionName,
    CompileMode -> FilePath
cbOutputName :: FilePath,
    CompileMode -> [FilePath]
cbLinkFlags :: [String]
  } |
  CompileFast {
    CompileMode -> CategoryName
cfCategory :: CategoryName,
    CompileMode -> FunctionName
cfFunction :: FunctionName,
    CompileMode -> FilePath
cfSource :: FilePath
  } |
  ExecuteTests {
    CompileMode -> [FilePath]
etInclude :: [FilePath]
  } |
  CompileIncremental {
    CompileMode -> [FilePath]
ciLinkFlags :: [String]
  } |
  CompileRecompile |
  CompileRecompileRecursive |
  CreateTemplates |
  CompileUnspecified
  deriving (CompileMode -> CompileMode -> Bool
(CompileMode -> CompileMode -> Bool)
-> (CompileMode -> CompileMode -> Bool) -> Eq CompileMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileMode -> CompileMode -> Bool
$c/= :: CompileMode -> CompileMode -> Bool
== :: CompileMode -> CompileMode -> Bool
$c== :: CompileMode -> CompileMode -> Bool
Eq,Int -> CompileMode -> ShowS
[CompileMode] -> ShowS
CompileMode -> FilePath
(Int -> CompileMode -> ShowS)
-> (CompileMode -> FilePath)
-> ([CompileMode] -> ShowS)
-> Show CompileMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompileMode] -> ShowS
$cshowList :: [CompileMode] -> ShowS
show :: CompileMode -> FilePath
$cshow :: CompileMode -> FilePath
showsPrec :: Int -> CompileMode -> ShowS
$cshowsPrec :: Int -> CompileMode -> ShowS
Show)

isCompileBinary :: CompileMode -> Bool
isCompileBinary :: CompileMode -> Bool
isCompileBinary (CompileBinary CategoryName
_ FunctionName
_ FilePath
_ [FilePath]
_) = Bool
True
isCompileBinary CompileMode
_                       = Bool
False

isCompileFast :: CompileMode -> Bool
isCompileFast :: CompileMode -> Bool
isCompileFast (CompileFast CategoryName
_ FunctionName
_ FilePath
_) = Bool
True
isCompileFast CompileMode
_                   = Bool
False

isCompileIncremental :: CompileMode -> Bool
isCompileIncremental :: CompileMode -> Bool
isCompileIncremental (CompileIncremental [FilePath]
_) = Bool
True
isCompileIncremental CompileMode
_                      = Bool
False

isCompileRecompile :: CompileMode -> Bool
isCompileRecompile :: CompileMode -> Bool
isCompileRecompile CompileMode
CompileRecompile          = Bool
True
isCompileRecompile CompileMode
CompileRecompileRecursive = Bool
True
isCompileRecompile CompileMode
_                         = Bool
False

isExecuteTests :: CompileMode -> Bool
isExecuteTests :: CompileMode -> Bool
isExecuteTests (ExecuteTests [FilePath]
_) = Bool
True
isExecuteTests CompileMode
_                = Bool
False

isCreateTemplates :: CompileMode -> Bool
isCreateTemplates :: CompileMode -> Bool
isCreateTemplates CompileMode
CreateTemplates = Bool
True
isCreateTemplates CompileMode
_               = Bool
False

maybeDisableHelp :: HelpMode -> HelpMode
maybeDisableHelp :: HelpMode -> HelpMode
maybeDisableHelp HelpMode
HelpUnspecified = HelpMode
HelpNotNeeded
maybeDisableHelp HelpMode
h               = HelpMode
h

getLinkFlags :: CompileMode -> [String]
getLinkFlags :: CompileMode -> [FilePath]
getLinkFlags (CompileBinary CategoryName
_ FunctionName
_ FilePath
_ [FilePath]
lf) = [FilePath]
lf
getLinkFlags (CompileIncremental [FilePath]
lf)  = [FilePath]
lf
getLinkFlags CompileMode
_                        = []