{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}

module Development.Shake.ATS.Type ( ForeignCabal (..)
                                  , Version (..)
                                  , ATSTarget (..)
                                  , ArtifactType (..)
                                  , ATSToolConfig (..)
                                  , ATSGen (..)
                                  -- * Lenses
                                  , atsTarget
                                  , hasPretty
                                  , cFlags
                                  , otherDeps
                                  , toolConfig
                                  , cc
                                  , linkStatic
                                  , src
                                  , gc
                                  , binTarget
                                  , genTargets
                                  , hsLibs
                                  , libs
                                  , patsHome
                                  , patsHomeLocs
                                  , tgtType
                                  , linkTargets
                                  ) where

import           Data.Binary         (Binary (..))
import           Data.Dependency     (Version (..))
import           Data.Hashable       (Hashable)
import qualified Data.Text.Lazy      as TL
import           Development.Shake.C
import           GHC.Generics        (Generic)
import           Lens.Micro.TH

-- We should have four build types:
--
-- 1. Static library
--
-- 2. Dynamic library
--
-- 3. Binary
--
-- 4. C sources
--
-- AND variations on these where a Haskell library is to be built
-- Or a C library.
--
-- Also they should account for whatever `atspkg` installs.

-- Package management idea:
--
-- * One big index
--
-- * Versions resolved from that
--
-- * Then we temporarily set the dependencies
--
-- * Ideally something with C dependencies included.
--
-- * Also binary caches are good.

deriving instance Generic CCompiler
deriving instance Binary CCompiler

data ArtifactType = StaticLibrary
                  | Executable
                  | SharedLibrary
                  deriving ((forall x. ArtifactType -> Rep ArtifactType x)
-> (forall x. Rep ArtifactType x -> ArtifactType)
-> Generic ArtifactType
forall x. Rep ArtifactType x -> ArtifactType
forall x. ArtifactType -> Rep ArtifactType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArtifactType x -> ArtifactType
$cfrom :: forall x. ArtifactType -> Rep ArtifactType x
Generic, Get ArtifactType
[ArtifactType] -> Put
ArtifactType -> Put
(ArtifactType -> Put)
-> Get ArtifactType
-> ([ArtifactType] -> Put)
-> Binary ArtifactType
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ArtifactType] -> Put
$cputList :: [ArtifactType] -> Put
get :: Get ArtifactType
$cget :: Get ArtifactType
put :: ArtifactType -> Put
$cput :: ArtifactType -> Put
Binary)

-- | Information about where to find @patscc@ and @patsopt@.
data ATSToolConfig = ATSToolConfig { ATSToolConfig -> String
_patsHome     :: String -- ^ Value to be used for @PATSHOME@.
                                   , ATSToolConfig -> String
_patsHomeLocs :: String -- ^ Value to be used for @PATSHOMELOCS@.
                                   , ATSToolConfig -> Bool
_hasPretty    :: Bool -- ^ Whether to display errors via @pats-filter@
                                   , ATSToolConfig -> CCompiler
_cc           :: CCompiler -- ^ C compiler to be used
                                   , ATSToolConfig -> Bool
_linkStatic   :: Bool -- ^ Force static linking
                                   } deriving ((forall x. ATSToolConfig -> Rep ATSToolConfig x)
-> (forall x. Rep ATSToolConfig x -> ATSToolConfig)
-> Generic ATSToolConfig
forall x. Rep ATSToolConfig x -> ATSToolConfig
forall x. ATSToolConfig -> Rep ATSToolConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ATSToolConfig x -> ATSToolConfig
$cfrom :: forall x. ATSToolConfig -> Rep ATSToolConfig x
Generic, Get ATSToolConfig
[ATSToolConfig] -> Put
ATSToolConfig -> Put
(ATSToolConfig -> Put)
-> Get ATSToolConfig
-> ([ATSToolConfig] -> Put)
-> Binary ATSToolConfig
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ATSToolConfig] -> Put
$cputList :: [ATSToolConfig] -> Put
get :: Get ATSToolConfig
$cget :: Get ATSToolConfig
put :: ATSToolConfig -> Put
$cput :: ATSToolConfig -> Put
Binary)

data ATSGen = ATSGen { ATSGen -> String
hsFile     :: FilePath -- ^ Haskell file containing types
                     , ATSGen -> String
_atsTarget :: FilePath -- ^ ATS file to be generated
                     , ATSGen -> Bool
cpphs      :: Bool -- ^ Whether to use the C preprocessor on the Haskell code
                     } deriving ((forall x. ATSGen -> Rep ATSGen x)
-> (forall x. Rep ATSGen x -> ATSGen) -> Generic ATSGen
forall x. Rep ATSGen x -> ATSGen
forall x. ATSGen -> Rep ATSGen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ATSGen x -> ATSGen
$cfrom :: forall x. ATSGen -> Rep ATSGen x
Generic, Get ATSGen
[ATSGen] -> Put
ATSGen -> Put
(ATSGen -> Put) -> Get ATSGen -> ([ATSGen] -> Put) -> Binary ATSGen
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ATSGen] -> Put
$cputList :: [ATSGen] -> Put
get :: Get ATSGen
$cget :: Get ATSGen
put :: ATSGen -> Put
$cput :: ATSGen -> Put
Binary)

-- | Type for binary and library builds with ATS.
data ATSTarget = ATSTarget { ATSTarget -> [String]
_cFlags      :: [String] -- ^ Flags to be passed to the C compiler
                           , ATSTarget -> ATSToolConfig
_toolConfig  :: ATSToolConfig -- ^ Configuration options for @patsopt@
                           , ATSTarget -> Bool
_gc          :: Bool -- ^ Whether to build with the garbage collection enabled
                           , ATSTarget -> [String]
_libs        :: [String] -- ^ Libraries against which to link
                           , ATSTarget -> [String]
_src         :: [FilePath] -- ^ ATS source files. If building an executable, at most one may contain @main0@.
                           , ATSTarget -> [ForeignCabal]
_hsLibs      :: [ForeignCabal] -- ^ Cabal-based Haskell libraries.
                           , ATSTarget -> [ATSGen]
_genTargets  :: [ATSGen] -- ^ Files to be run through @hs2ats@.
                           , ATSTarget -> [(String, String)]
_linkTargets :: [(FilePath, FilePath)] -- ^ Targets for @_link.hats@ generation.
                           , ATSTarget -> String
_binTarget   :: FilePath -- ^ Target
                           , ATSTarget -> [String]
_otherDeps   :: [FilePath] -- ^ Other files to track.
                           , ATSTarget -> ArtifactType
_tgtType     :: ArtifactType -- ^ Build type
                           } deriving ((forall x. ATSTarget -> Rep ATSTarget x)
-> (forall x. Rep ATSTarget x -> ATSTarget) -> Generic ATSTarget
forall x. Rep ATSTarget x -> ATSTarget
forall x. ATSTarget -> Rep ATSTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ATSTarget x -> ATSTarget
$cfrom :: forall x. ATSTarget -> Rep ATSTarget x
Generic, Get ATSTarget
[ATSTarget] -> Put
ATSTarget -> Put
(ATSTarget -> Put)
-> Get ATSTarget -> ([ATSTarget] -> Put) -> Binary ATSTarget
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ATSTarget] -> Put
$cputList :: [ATSTarget] -> Put
get :: Get ATSTarget
$cget :: Get ATSTarget
put :: ATSTarget -> Put
$cput :: ATSTarget -> Put
Binary)

-- | Data type containing information about Haskell components of a build. Any
-- functions exposed in the object file will be callable in C or ATS code.
data ForeignCabal = ForeignCabal { ForeignCabal -> Maybe Text
projectFile :: Maybe TL.Text -- ^ @cabal.project@ file to track
                                 , ForeignCabal -> Text
cabalFile   :: TL.Text -- ^ @.cabal@ file associated with the library
                                 , ForeignCabal -> Text
objectFile  :: TL.Text -- ^ Object file to be generated
                                 } deriving (ForeignCabal -> ForeignCabal -> Bool
(ForeignCabal -> ForeignCabal -> Bool)
-> (ForeignCabal -> ForeignCabal -> Bool) -> Eq ForeignCabal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignCabal -> ForeignCabal -> Bool
$c/= :: ForeignCabal -> ForeignCabal -> Bool
== :: ForeignCabal -> ForeignCabal -> Bool
$c== :: ForeignCabal -> ForeignCabal -> Bool
Eq, Int -> ForeignCabal -> ShowS
[ForeignCabal] -> ShowS
ForeignCabal -> String
(Int -> ForeignCabal -> ShowS)
-> (ForeignCabal -> String)
-> ([ForeignCabal] -> ShowS)
-> Show ForeignCabal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignCabal] -> ShowS
$cshowList :: [ForeignCabal] -> ShowS
show :: ForeignCabal -> String
$cshow :: ForeignCabal -> String
showsPrec :: Int -> ForeignCabal -> ShowS
$cshowsPrec :: Int -> ForeignCabal -> ShowS
Show, (forall x. ForeignCabal -> Rep ForeignCabal x)
-> (forall x. Rep ForeignCabal x -> ForeignCabal)
-> Generic ForeignCabal
forall x. Rep ForeignCabal x -> ForeignCabal
forall x. ForeignCabal -> Rep ForeignCabal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForeignCabal x -> ForeignCabal
$cfrom :: forall x. ForeignCabal -> Rep ForeignCabal x
Generic, Get ForeignCabal
[ForeignCabal] -> Put
ForeignCabal -> Put
(ForeignCabal -> Put)
-> Get ForeignCabal
-> ([ForeignCabal] -> Put)
-> Binary ForeignCabal
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ForeignCabal] -> Put
$cputList :: [ForeignCabal] -> Put
get :: Get ForeignCabal
$cget :: Get ForeignCabal
put :: ForeignCabal -> Put
$cput :: ForeignCabal -> Put
Binary, Int -> ForeignCabal -> Int
ForeignCabal -> Int
(Int -> ForeignCabal -> Int)
-> (ForeignCabal -> Int) -> Hashable ForeignCabal
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ForeignCabal -> Int
$chash :: ForeignCabal -> Int
hashWithSalt :: Int -> ForeignCabal -> Int
$chashWithSalt :: Int -> ForeignCabal -> Int
Hashable)

makeLenses ''ATSGen
makeLenses ''ATSTarget
makeLenses ''ATSToolConfig