{- -----------------------------------------------------------------------------
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileMetadata -> CompileMetadata -> Bool
$c/= :: CompileMetadata -> CompileMetadata -> Bool
== :: CompileMetadata -> CompileMetadata -> Bool
$c== :: CompileMetadata -> CompileMetadata -> Bool
Eq,Int -> CompileMetadata -> ShowS
[CompileMetadata] -> ShowS
CompileMetadata -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompileMetadata] -> ShowS
$cshowList :: [CompileMetadata] -> ShowS
show :: CompileMetadata -> FilePath
$cshow :: CompileMetadata -> FilePath
showsPrec :: Int -> CompileMetadata -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectFile -> ObjectFile -> Bool
$c/= :: ObjectFile -> ObjectFile -> Bool
== :: ObjectFile -> ObjectFile -> Bool
$c== :: ObjectFile -> ObjectFile -> Bool
Eq,Int -> ObjectFile -> ShowS
[ObjectFile] -> ShowS
ObjectFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ObjectFile] -> ShowS
$cshowList :: [ObjectFile] -> ShowS
show :: ObjectFile -> FilePath
$cshow :: ObjectFile -> FilePath
showsPrec :: Int -> ObjectFile -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c/= :: CategoryIdentifier -> CategoryIdentifier -> Bool
== :: CategoryIdentifier -> CategoryIdentifier -> Bool
$c== :: CategoryIdentifier -> CategoryIdentifier -> Bool
Eq,Eq 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
min :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
$cmin :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
max :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
$cmax :: CategoryIdentifier -> CategoryIdentifier -> CategoryIdentifier
>= :: CategoryIdentifier -> CategoryIdentifier -> Bool
$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
compare :: CategoryIdentifier -> CategoryIdentifier -> Ordering
$ccompare :: CategoryIdentifier -> CategoryIdentifier -> Ordering
Ord,Int -> CategoryIdentifier -> ShowS
[CategoryIdentifier] -> ShowS
CategoryIdentifier -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CategoryIdentifier] -> ShowS
$cshowList :: [CategoryIdentifier] -> ShowS
show :: CategoryIdentifier -> FilePath
$cshow :: CategoryIdentifier -> FilePath
showsPrec :: Int -> CategoryIdentifier -> ShowS
$cshowsPrec :: Int -> 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 (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [CategoryIdentifier]
rs1 forall a. [a] -> [a] -> [a]
++ [CategoryIdentifier]
rs2) (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [FilePath]
fs1 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
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
showList :: [CategorySpec c] -> ShowS
$cshowList :: forall c. Show c => [CategorySpec c] -> ShowS
show :: CategorySpec c -> FilePath
$cshow :: forall c. Show c => CategorySpec c -> FilePath
showsPrec :: Int -> CategorySpec c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleConfig] -> ShowS
$cshowList :: [ModuleConfig] -> ShowS
show :: ModuleConfig -> FilePath
$cshow :: ModuleConfig -> FilePath
showsPrec :: Int -> ModuleConfig -> ShowS
$cshowsPrec :: Int -> 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) =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. a -> a
id [
        FilePath
pA forall a. Eq a => a -> a -> Bool
== FilePath
pB,
        [FilePath]
eeA forall a. Eq a => a -> a -> Bool
== [FilePath]
eeB,
        FilePath
dA forall a. Eq a => a -> a -> Bool
== FilePath
dB,
        [FilePath]
isA forall a. Eq a => a -> a -> Bool
== [FilePath]
isB,
        [FilePath]
is2A forall a. Eq a => a -> a -> Bool
== [FilePath]
is2B,
        [ExtraSource]
esA forall a. Eq a => a -> a -> Bool
== [ExtraSource]
esB,
        forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(CategoryName, CategorySpec SourceContext)]
cA forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(CategoryName, CategorySpec SourceContext)]
cB,
        forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueRefine c -> TypeInstance
vrType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CategorySpec c -> [ValueRefine c]
csRefines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cA forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueRefine c -> TypeInstance
vrType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CategorySpec c -> [ValueRefine c]
csRefines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cB,
        forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueDefine c -> DefinesInstance
vdType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CategorySpec c -> [ValueDefine c]
csDefines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cA forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueDefine c -> DefinesInstance
vdType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CategorySpec c -> [ValueDefine c]
csDefines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(CategoryName, CategorySpec SourceContext)]
cB,
        [FilePath]
epA forall a. Eq a => a -> a -> Bool
== [FilePath]
epB,
        CompileMode
mA forall a. Eq a => a -> a -> Bool
== CompileMode
mB
      ]