{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module SuperUserSpark.Compiler.Types where

import Import

import Data.Aeson
       (FromJSON(..), ToJSON(..), object, (.:), (.=), withObject)

import SuperUserSpark.CoreTypes
import SuperUserSpark.Language.Types
import SuperUserSpark.Parser.Types
import SuperUserSpark.PreCompiler.Types

data CompileAssignment = CompileAssignment
    { compileCardReference :: StrongCardFileReference
    , compileOutput :: Maybe (Path Abs File)
    , compileSettings :: CompileSettings
    } deriving (Show, Eq, Generic)

instance Validity CompileAssignment

data StrongCardFileReference =
    StrongCardFileReference (Path Abs File)
                            (Maybe CardNameReference)
    deriving (Show, Eq, Generic)

instance Validity StrongCardFileReference

data StrongCardReference
    = StrongCardFile StrongCardFileReference
    | StrongCardName CardNameReference
    deriving (Show, Eq, Generic)

instance Validity StrongCardReference

data CompileSettings = CompileSettings
    { compileDefaultKind :: DeploymentKind
    , compileKindOverride :: Maybe DeploymentKind
    } deriving (Show, Eq, Generic)

instance Validity CompileSettings

defaultCompileSettings :: CompileSettings
defaultCompileSettings =
    CompileSettings
    {compileDefaultKind = LinkDeployment, compileKindOverride = Nothing}

type RawDeployment = Deployment FilePath

data Deployment a = Deployment
    { deploymentDirections :: DeploymentDirections a
    , deploymentKind :: DeploymentKind
    } deriving (Show, Eq, Generic)

instance Validity a =>
         Validity (Deployment a)

instance FromJSON a =>
         FromJSON (Deployment a) where
    parseJSON =
        withObject "Deployment" $ \o ->
            Deployment <$> o .: "directions" <*> o .: "deployment kind"

instance ToJSON a =>
         ToJSON (Deployment a) where
    toJSON depl =
        object
            [ "directions" .= deploymentDirections depl
            , "deployment kind" .= deploymentKind depl
            ]

instance Functor Deployment where
    fmap f (Deployment dis dk) = Deployment (fmap f dis) dk

data DeploymentDirections a = Directions
    { directionSources :: [a]
    , directionDestination :: a
    } deriving (Show, Eq, Generic)

instance Validity a =>
         Validity (DeploymentDirections a)

instance ToJSON a =>
         ToJSON (DeploymentDirections a) where
    toJSON (Directions srcs dst) =
        object ["sources" .= srcs, "destination" .= dst]

instance FromJSON a =>
         FromJSON (DeploymentDirections a) where
    parseJSON =
        withObject "Deployment Directions" $ \o ->
            Directions <$> o .: "sources" <*> o .: "destination"

instance Functor DeploymentDirections where
    fmap f (Directions srcs dst) = Directions (map f srcs) (f dst)

type CompilerPrefix = [PrefixPart]

data PrefixPart
    = Literal String
    | Alts [String]
    deriving (Show, Eq, Generic)

instance Validity PrefixPart

data CompilerState = CompilerState
    { stateDeploymentKindLocalOverride :: Maybe DeploymentKind
    , stateInto :: Directory
    , stateOutofPrefix :: CompilerPrefix
    } deriving (Show, Eq, Generic)

instance Validity CompilerState

type ImpureCompiler = ExceptT CompileError (ReaderT CompileSettings IO)

type PureCompiler = ExceptT CompileError (ReaderT CompileSettings Identity)

type InternalCompiler = StateT CompilerState (WriterT ([RawDeployment], [CardReference]) PureCompiler)

data CompileError
    = CompileParseError ParseError
    | PreCompileErrors [PreCompileError]
    | DuringCompilationError String
    deriving (Show, Eq, Generic)

instance Validity CompileError