{- -----------------------------------------------------------------------------
Copyright 2020-2021 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 TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}

module Cli.CompileOptions (
  CompileOptions(..),
  CompileMode(..),
  ExtraSource(..),
  ForceMode(..),
  HelpMode(..),
  LinkerMode(..),
  emptyCompileOptions,
  getLinkFlags,
  getSourceCategories,
  getSourceDeps,
  getSourceFile,
  isCompileBinary,
  isCompileFast,
  isCompileIncremental,
  isCompileRecompile,
  isCompileUnspecified,
  isCreateTemplates,
  isExecuteTests,
  maybeDisableHelp,
  -- Generated by Lens >>>
  coExtraFiles,
  coExtraPaths,
  coForce,
  coHelp,
  coMode,
  coParallel,
  coPaths,
  coPrivateDeps,
  coPublicDeps,
  coSourcePrefix,
  -- Generated by Lens <<<
) where

import Lens.Micro.TH (makeLenses)

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


emptyCompileOptions :: CompileOptions
emptyCompileOptions :: CompileOptions
emptyCompileOptions =
  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,
    _coParallel :: Int
_coParallel = Int
0
  }

data ExtraSource =
  CategorySource {
    ExtraSource -> FilePath
csSource :: FilePath,
    ExtraSource -> [CategoryName]
csCategories :: [CategoryName],
    ExtraSource -> [CategoryName]
csRequires :: [CategoryName]
  } |
  OtherSource {
    ExtraSource -> FilePath
osSource :: FilePath
  }
  deriving (ExtraSource -> ExtraSource -> Bool
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
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
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
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
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
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
Ord,Int -> ForceMode -> ShowS
[ForceMode] -> ShowS
ForceMode -> FilePath
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 -> LinkerMode
cbLinker :: LinkerMode,
    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],
    CompileMode -> Maybe FilePath
etCallLog :: Maybe FilePath
  } |
  CompileIncremental {
    CompileMode -> [FilePath]
ciLinkFlags :: [String]
  } |
  CompileRecompile |
  CompileRecompileRecursive |
  CreateTemplates |
  CompileUnspecified
  deriving (CompileMode -> CompileMode -> Bool
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
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)

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

isCompileBinary :: CompileMode -> Bool
isCompileBinary :: CompileMode -> Bool
isCompileBinary (CompileBinary CategoryName
_ FunctionName
_ LinkerMode
_ 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]
_ Maybe FilePath
_) = Bool
True
isExecuteTests CompileMode
_                  = Bool
False

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

isCompileUnspecified :: CompileMode -> Bool
isCompileUnspecified :: CompileMode -> Bool
isCompileUnspecified CompileMode
CompileUnspecified = Bool
True
isCompileUnspecified 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
_ LinkerMode
_ FilePath
_ [FilePath]
lf) = [FilePath]
lf
getLinkFlags (CompileIncremental [FilePath]
lf)    = [FilePath]
lf
getLinkFlags CompileMode
_                          = []

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,
    CompileOptions -> Int
_coParallel :: Int
  }
  deriving (Int -> CompileOptions -> ShowS
[CompileOptions] -> ShowS
CompileOptions -> FilePath
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)

$(makeLenses ''CompileOptions)