{- -----------------------------------------------------------------------------
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]

module Module.CompileMetadata (
  CategoryIdentifier(..),
  CategorySpec(..),
  CompileMetadata(..),
  ModuleConfig(..),
  ObjectFile(..),
  isCategoryObjectFile,
  getObjectFiles,
  mergeObjectFiles,
) where

import Data.List (nub)

import Cli.CompileOptions
import Cli.Programs (VersionHash)
import Parser.TextParser (SourceContext)
import Types.Procedure (Expression,MacroName)
import Types.TypeCategory
import Types.TypeInstance (CategoryName)


data CompileMetadata =
  CompileMetadata {
    CompileMetadata -> VersionHash
cmVersionHash :: VersionHash,
    CompileMetadata -> FilePath
cmRoot :: FilePath,
    CompileMetadata -> FilePath
cmPath :: FilePath,
    CompileMetadata -> [FilePath]
cmExtra :: [FilePath],
    CompileMetadata -> Namespace
cmPublicNamespace :: Namespace,
    CompileMetadata -> Namespace
cmPrivateNamespace :: Namespace,
    CompileMetadata -> [FilePath]
cmPublicDeps :: [FilePath],
    CompileMetadata -> [FilePath]
cmPrivateDeps :: [FilePath],
    CompileMetadata -> [CategoryName]
cmPublicCategories :: [CategoryName],
    CompileMetadata -> [CategoryName]
cmPrivateCategories :: [CategoryName],
    CompileMetadata -> [FilePath]
cmPublicSubdirs :: [FilePath],
    CompileMetadata -> [FilePath]
cmPrivateSubdirs :: [FilePath],
    CompileMetadata -> [FilePath]
cmPublicFiles :: [FilePath],
    CompileMetadata -> [FilePath]
cmPrivateFiles :: [FilePath],
    CompileMetadata -> [FilePath]
cmTestFiles :: [FilePath],
    CompileMetadata -> [FilePath]
cmHxxFiles :: [FilePath],
    CompileMetadata -> [FilePath]
cmCxxFiles :: [FilePath],
    CompileMetadata -> [FilePath]
cmBinaries :: [FilePath],
    CompileMetadata -> [FilePath]
cmLibraries :: [FilePath],
    CompileMetadata -> [FilePath]
cmLinkFlags :: [FilePath],
    CompileMetadata -> [ObjectFile]
cmObjectFiles :: [ObjectFile]
  }
  deriving (CompileMetadata -> CompileMetadata -> Bool
(CompileMetadata -> CompileMetadata -> Bool)
-> (CompileMetadata -> CompileMetadata -> Bool)
-> Eq CompileMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompileMetadata -> CompileMetadata -> Bool
== :: CompileMetadata -> CompileMetadata -> Bool
$c/= :: CompileMetadata -> CompileMetadata -> Bool
/= :: CompileMetadata -> CompileMetadata -> Bool
Eq,Int -> CompileMetadata -> ShowS
[CompileMetadata] -> ShowS
CompileMetadata -> FilePath
(Int -> CompileMetadata -> ShowS)
-> (CompileMetadata -> FilePath)
-> ([CompileMetadata] -> ShowS)
-> Show CompileMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileMetadata -> ShowS
showsPrec :: Int -> CompileMetadata -> ShowS
$cshow :: CompileMetadata -> FilePath
show :: CompileMetadata -> FilePath
$cshowList :: [CompileMetadata] -> ShowS
showList :: [CompileMetadata] -> ShowS
Show)

data ObjectFile =
  CategoryObjectFile {
    ObjectFile -> CategoryIdentifier
cofCategory :: CategoryIdentifier,
    ObjectFile -> [CategoryIdentifier]
cofRequires :: [CategoryIdentifier],
    ObjectFile -> [FilePath]
cofFiles :: [FilePath]
  } |
  OtherObjectFile {
    ObjectFile -> FilePath
oofFile :: FilePath
  }
  deriving (ObjectFile -> ObjectFile -> Bool
(ObjectFile -> ObjectFile -> Bool)
-> (ObjectFile -> ObjectFile -> Bool) -> Eq ObjectFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectFile -> ObjectFile -> Bool
== :: ObjectFile -> ObjectFile -> Bool
$c/= :: ObjectFile -> ObjectFile -> Bool
/= :: ObjectFile -> ObjectFile -> Bool
Eq,Int -> ObjectFile -> ShowS
[ObjectFile] -> ShowS
ObjectFile -> FilePath
(Int -> ObjectFile -> ShowS)
-> (ObjectFile -> FilePath)
-> ([ObjectFile] -> ShowS)
-> Show ObjectFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectFile -> ShowS
showsPrec :: Int -> ObjectFile -> ShowS
$cshow :: ObjectFile -> FilePath
show :: ObjectFile -> FilePath
$cshowList :: [ObjectFile] -> ShowS
showList :: [ObjectFile] -> ShowS
Show)

data CategoryIdentifier =
  CategoryIdentifier {
    CategoryIdentifier -> FilePath
ciPath :: FilePath,
    CategoryIdentifier -> CategoryName
ciCategory :: CategoryName,
    CategoryIdentifier -> Namespace
ciNamespace :: Namespace
  } |
  UnresolvedCategory {
    CategoryIdentifier -> CategoryName
ucCategory :: CategoryName
  }
  deriving (CategoryIdentifier -> CategoryIdentifier -> Bool
(CategoryIdentifier -> CategoryIdentifier -> Bool)
-> (CategoryIdentifier -> CategoryIdentifier -> Bool)
-> Eq CategoryIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CategoryIdentifier -> CategoryIdentifier -> Bool
== :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c/= :: CategoryIdentifier -> CategoryIdentifier -> Bool
/= :: CategoryIdentifier -> CategoryIdentifier -> Bool
Eq,Eq CategoryIdentifier
Eq CategoryIdentifier =>
(CategoryIdentifier -> CategoryIdentifier -> Ordering)
-> (CategoryIdentifier -> CategoryIdentifier -> Bool)
-> (CategoryIdentifier -> CategoryIdentifier -> Bool)
-> (CategoryIdentifier -> CategoryIdentifier -> Bool)
-> (CategoryIdentifier -> CategoryIdentifier -> Bool)
-> (CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier)
-> (CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier)
-> Ord CategoryIdentifier
CategoryIdentifier -> CategoryIdentifier -> Bool
CategoryIdentifier -> CategoryIdentifier -> Ordering
CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
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
$ccompare :: CategoryIdentifier -> CategoryIdentifier -> Ordering
compare :: CategoryIdentifier -> CategoryIdentifier -> Ordering
$c< :: CategoryIdentifier -> CategoryIdentifier -> Bool
< :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c<= :: CategoryIdentifier -> CategoryIdentifier -> Bool
<= :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c> :: CategoryIdentifier -> CategoryIdentifier -> Bool
> :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c>= :: CategoryIdentifier -> CategoryIdentifier -> Bool
>= :: CategoryIdentifier -> CategoryIdentifier -> Bool
$cmax :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
max :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
$cmin :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
min :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
Ord,Int -> CategoryIdentifier -> ShowS
[CategoryIdentifier] -> ShowS
CategoryIdentifier -> FilePath
(Int -> CategoryIdentifier -> ShowS)
-> (CategoryIdentifier -> FilePath)
-> ([CategoryIdentifier] -> ShowS)
-> Show CategoryIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CategoryIdentifier -> ShowS
showsPrec :: Int -> CategoryIdentifier -> ShowS
$cshow :: CategoryIdentifier -> FilePath
show :: CategoryIdentifier -> FilePath
$cshowList :: [CategoryIdentifier] -> ShowS
showList :: [CategoryIdentifier] -> ShowS
Show)

getIdentifierCategory :: CategoryIdentifier -> CategoryName
getIdentifierCategory :: CategoryIdentifier -> CategoryName
getIdentifierCategory (CategoryIdentifier FilePath
_ CategoryName
n Namespace
_) = CategoryName
n
getIdentifierCategory (UnresolvedCategory CategoryName
n)     = CategoryName
n

mergeObjectFiles :: ObjectFile -> ObjectFile -> ObjectFile
mergeObjectFiles :: ObjectFile -> ObjectFile -> ObjectFile
mergeObjectFiles (CategoryObjectFile CategoryIdentifier
c [CategoryIdentifier]
rs1 [FilePath]
fs1) (CategoryObjectFile CategoryIdentifier
_ [CategoryIdentifier]
rs2 [FilePath]
fs2) =
  CategoryIdentifier
-> [CategoryIdentifier] -> [FilePath] -> ObjectFile
CategoryObjectFile CategoryIdentifier
c ([CategoryIdentifier] -> [CategoryIdentifier]
forall a. Eq a => [a] -> [a]
nub ([CategoryIdentifier] -> [CategoryIdentifier])
-> [CategoryIdentifier] -> [CategoryIdentifier]
forall a b. (a -> b) -> a -> b
$ [CategoryIdentifier]
rs1 [CategoryIdentifier]
-> [CategoryIdentifier] -> [CategoryIdentifier]
forall a. [a] -> [a] -> [a]
++ [CategoryIdentifier]
rs2) ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
fs1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
fs2)
mergeObjectFiles ObjectFile
o ObjectFile
_ = ObjectFile
o

isCategoryObjectFile :: ObjectFile -> Bool
isCategoryObjectFile :: ObjectFile -> Bool
isCategoryObjectFile (CategoryObjectFile CategoryIdentifier
_ [CategoryIdentifier]
_ [FilePath]
_) = Bool
True
isCategoryObjectFile (OtherObjectFile FilePath
_)        = Bool
False

getObjectFiles :: ObjectFile -> [FilePath]
getObjectFiles :: ObjectFile -> [FilePath]
getObjectFiles (CategoryObjectFile CategoryIdentifier
_ [CategoryIdentifier]
_ [FilePath]
os) = [FilePath]
os
getObjectFiles (OtherObjectFile FilePath
o)         = [FilePath
o]

data CategorySpec c =
  CategorySpec {
    forall c. CategorySpec c -> [c]
csContext :: [c],
    forall c. CategorySpec c -> [ValueRefine c]
csRefines :: [ValueRefine c],
    forall c. CategorySpec c -> [ValueDefine c]
csDefines :: [ValueDefine c]
  }
  deriving (Int -> CategorySpec c -> ShowS
[CategorySpec c] -> ShowS
CategorySpec c -> FilePath
(Int -> CategorySpec c -> ShowS)
-> (CategorySpec c -> FilePath)
-> ([CategorySpec c] -> ShowS)
-> Show (CategorySpec c)
forall c. Show c => Int -> CategorySpec c -> ShowS
forall c. Show c => [CategorySpec c] -> ShowS
forall c. Show c => CategorySpec c -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> CategorySpec c -> ShowS
showsPrec :: Int -> CategorySpec c -> ShowS
$cshow :: forall c. Show c => CategorySpec c -> FilePath
show :: CategorySpec c -> FilePath
$cshowList :: forall c. Show c => [CategorySpec c] -> ShowS
showList :: [CategorySpec c] -> ShowS
Show)

data ModuleConfig =
  ModuleConfig {
    ModuleConfig -> FilePath
mcRoot :: FilePath,
    ModuleConfig -> FilePath
mcPath :: FilePath,
    ModuleConfig -> [FilePath]
mcExtra :: [FilePath],
    ModuleConfig -> [(MacroName, Expression SourceContext)]
mcExprMap :: [(MacroName,Expression SourceContext)],
    ModuleConfig -> [FilePath]
mcPublicDeps :: [FilePath],
    ModuleConfig -> [FilePath]
mcPrivateDeps :: [FilePath],
    ModuleConfig -> [ExtraSource]
mcExtraFiles :: [ExtraSource],
    ModuleConfig -> [(CategoryName, CategorySpec SourceContext)]
mcCategories :: [(CategoryName,CategorySpec SourceContext)],
    ModuleConfig -> [FilePath]
mcExtraPaths :: [FilePath],
    ModuleConfig -> CompileMode
mcMode :: CompileMode
  }
  deriving (Int -> ModuleConfig -> ShowS
[ModuleConfig] -> ShowS
ModuleConfig -> FilePath
(Int -> ModuleConfig -> ShowS)
-> (ModuleConfig -> FilePath)
-> ([ModuleConfig] -> ShowS)
-> Show ModuleConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleConfig -> ShowS
showsPrec :: Int -> ModuleConfig -> ShowS
$cshow :: ModuleConfig -> FilePath
show :: ModuleConfig -> FilePath
$cshowList :: [ModuleConfig] -> ShowS
showList :: [ModuleConfig] -> ShowS
Show)

instance Eq ModuleConfig where
  (ModuleConfig FilePath
pA FilePath
dA [FilePath]
eeA [(MacroName, Expression SourceContext)]
_ [FilePath]
isA [FilePath]
is2A [ExtraSource]
esA [(CategoryName, CategorySpec SourceContext)]
cA [FilePath]
epA CompileMode
mA) == :: ModuleConfig -> ModuleConfig -> Bool
== (ModuleConfig FilePath
pB FilePath
dB [FilePath]
eeB [(MacroName, Expression SourceContext)]
_ [FilePath]
isB [FilePath]
is2B [ExtraSource]
esB [(CategoryName, CategorySpec SourceContext)]
cB [FilePath]
epB CompileMode
mB) =
    (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id [
        FilePath
pA FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
pB,
        [FilePath]
eeA [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath]
eeB,
        FilePath
dA FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dB,
        [FilePath]
isA [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath]
isB,
        [FilePath]
is2A [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath]
is2B,
        [ExtraSource]
esA [ExtraSource] -> [ExtraSource] -> Bool
forall a. Eq a => a -> a -> Bool
== [ExtraSource]
esB,
        ((CategoryName, CategorySpec SourceContext) -> CategoryName)
-> [(CategoryName, CategorySpec SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, CategorySpec SourceContext) -> CategoryName
forall a b. (a, b) -> a
fst [(CategoryName, CategorySpec SourceContext)]
cA [CategoryName] -> [CategoryName] -> Bool
forall a. Eq a => a -> a -> Bool
== ((CategoryName, CategorySpec SourceContext) -> CategoryName)
-> [(CategoryName, CategorySpec SourceContext)] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, CategorySpec SourceContext) -> CategoryName
forall a b. (a, b) -> a
fst [(CategoryName, CategorySpec SourceContext)]
cB,
        ((CategoryName, CategorySpec SourceContext) -> [TypeInstance])
-> [(CategoryName, CategorySpec SourceContext)] -> [[TypeInstance]]
forall a b. (a -> b) -> [a] -> [b]
map ((ValueRefine SourceContext -> TypeInstance)
-> [ValueRefine SourceContext] -> [TypeInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueRefine SourceContext -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ([ValueRefine SourceContext] -> [TypeInstance])
-> ((CategoryName, CategorySpec SourceContext)
    -> [ValueRefine SourceContext])
-> (CategoryName, CategorySpec SourceContext)
-> [TypeInstance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategorySpec SourceContext -> [ValueRefine SourceContext]
forall c. CategorySpec c -> [ValueRefine c]
csRefines (CategorySpec SourceContext -> [ValueRefine SourceContext])
-> ((CategoryName, CategorySpec SourceContext)
    -> CategorySpec SourceContext)
-> (CategoryName, CategorySpec SourceContext)
-> [ValueRefine SourceContext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName, CategorySpec SourceContext)
-> CategorySpec SourceContext
forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cA [[TypeInstance]] -> [[TypeInstance]] -> Bool
forall a. Eq a => a -> a -> Bool
== ((CategoryName, CategorySpec SourceContext) -> [TypeInstance])
-> [(CategoryName, CategorySpec SourceContext)] -> [[TypeInstance]]
forall a b. (a -> b) -> [a] -> [b]
map ((ValueRefine SourceContext -> TypeInstance)
-> [ValueRefine SourceContext] -> [TypeInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueRefine SourceContext -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ([ValueRefine SourceContext] -> [TypeInstance])
-> ((CategoryName, CategorySpec SourceContext)
    -> [ValueRefine SourceContext])
-> (CategoryName, CategorySpec SourceContext)
-> [TypeInstance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategorySpec SourceContext -> [ValueRefine SourceContext]
forall c. CategorySpec c -> [ValueRefine c]
csRefines (CategorySpec SourceContext -> [ValueRefine SourceContext])
-> ((CategoryName, CategorySpec SourceContext)
    -> CategorySpec SourceContext)
-> (CategoryName, CategorySpec SourceContext)
-> [ValueRefine SourceContext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName, CategorySpec SourceContext)
-> CategorySpec SourceContext
forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cB,
        ((CategoryName, CategorySpec SourceContext) -> [DefinesInstance])
-> [(CategoryName, CategorySpec SourceContext)]
-> [[DefinesInstance]]
forall a b. (a -> b) -> [a] -> [b]
map ((ValueDefine SourceContext -> DefinesInstance)
-> [ValueDefine SourceContext] -> [DefinesInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueDefine SourceContext -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType ([ValueDefine SourceContext] -> [DefinesInstance])
-> ((CategoryName, CategorySpec SourceContext)
    -> [ValueDefine SourceContext])
-> (CategoryName, CategorySpec SourceContext)
-> [DefinesInstance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategorySpec SourceContext -> [ValueDefine SourceContext]
forall c. CategorySpec c -> [ValueDefine c]
csDefines (CategorySpec SourceContext -> [ValueDefine SourceContext])
-> ((CategoryName, CategorySpec SourceContext)
    -> CategorySpec SourceContext)
-> (CategoryName, CategorySpec SourceContext)
-> [ValueDefine SourceContext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName, CategorySpec SourceContext)
-> CategorySpec SourceContext
forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cA [[DefinesInstance]] -> [[DefinesInstance]] -> Bool
forall a. Eq a => a -> a -> Bool
== ((CategoryName, CategorySpec SourceContext) -> [DefinesInstance])
-> [(CategoryName, CategorySpec SourceContext)]
-> [[DefinesInstance]]
forall a b. (a -> b) -> [a] -> [b]
map ((ValueDefine SourceContext -> DefinesInstance)
-> [ValueDefine SourceContext] -> [DefinesInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueDefine SourceContext -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType ([ValueDefine SourceContext] -> [DefinesInstance])
-> ((CategoryName, CategorySpec SourceContext)
    -> [ValueDefine SourceContext])
-> (CategoryName, CategorySpec SourceContext)
-> [DefinesInstance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategorySpec SourceContext -> [ValueDefine SourceContext]
forall c. CategorySpec c -> [ValueDefine c]
csDefines (CategorySpec SourceContext -> [ValueDefine SourceContext])
-> ((CategoryName, CategorySpec SourceContext)
    -> CategorySpec SourceContext)
-> (CategoryName, CategorySpec SourceContext)
-> [ValueDefine SourceContext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName, CategorySpec SourceContext)
-> CategorySpec SourceContext
forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cB,
        [FilePath]
epA [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath]
epB,
        CompileMode
mA CompileMode -> CompileMode -> Bool
forall a. Eq a => a -> a -> Bool
== CompileMode
mB
      ]