{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}


module BNFC.Backend.CommonInterface.Backend where

import Control.Monad.Except
import Control.Monad.Writer
import Control.Monad.State

import Options.Applicative ( Parser )

import System.FilePath

import BNFC.CF
import BNFC.Prelude

import BNFC.Options.GlobalOptions
import BNFC.Options.Target

-- result generated by a backed: file paths and their contents.
type Result = [(FilePath, String)]

-- type used to log what the backends may print while generating files.
type Log = Writer String

-- output type, inclusive of the backend result and logging.
type Output = WriterT Result Log ()

-- | Backend typeclass.

class Backend (target :: TargetLanguage) where
  type BackendOptions target
  type BackendState target
  parseOpts      :: Parser (BackendOptions target)
  initState      :: LBNF -> GlobalOptions -> BackendOptions target
                      -> Except String (BackendState target)
  abstractSyntax :: LBNF -> State (BackendState target) Result
  printer        :: LBNF -> State (BackendState target) Result
  lexer          :: LBNF -> State (BackendState target) Result
  parser         :: LBNF -> State (BackendState target) Result
  parserTest     :: LBNF -> State (BackendState target) Result
  makefile       :: LBNF -> State (BackendState target) Result

runBackend ::
  forall target. Backend target =>
  GlobalOptions -> BackendOptions target -> LBNF -> Except String Result
runBackend :: GlobalOptions
-> BackendOptions target -> LBNF -> Except String Result
runBackend GlobalOptions
globalOpts BackendOptions target
backendOpts LBNF
cf = do
  BackendState target
st <- LBNF
-> GlobalOptions
-> BackendOptions target
-> Except String (BackendState target)
forall (target :: TargetLanguage).
Backend target =>
LBNF
-> GlobalOptions
-> BackendOptions target
-> Except String (BackendState target)
initState @target LBNF
cf GlobalOptions
globalOpts BackendOptions target
backendOpts
  Result -> Except String Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> Except String Result) -> Result -> Except String Result
forall a b. (a -> b) -> a -> b
$ (State (BackendState target) Result
 -> BackendState target -> Result)
-> BackendState target
-> State (BackendState target) Result
-> Result
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (BackendState target) Result -> BackendState target -> Result
forall s a. State s a -> s -> a
evalState BackendState target
st (State (BackendState target) Result -> Result)
-> State (BackendState target) Result -> Result
forall a b. (a -> b) -> a -> b
$ do
    Result
lexSpec   <- LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
lexer @target LBNF
cf
    Result
parSpec   <- LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
parser @target LBNF
cf
    Result
parTest   <- LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
parserTest @target LBNF
cf
    Result
absSpec   <- LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
abstractSyntax @target LBNF
cf
    Result
printSpec <- LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
printer @target LBNF
cf
    Result
mkfile    <-
      if GlobalOptions -> Bool
optMakeFile GlobalOptions
globalOpts
      then LBNF -> State (BackendState target) Result
forall (target :: TargetLanguage).
Backend target =>
LBNF -> State (BackendState target) Result
makefile @target LBNF
cf
      else Result -> State (BackendState target) Result
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Result -> State (BackendState target) Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> State (BackendState target) Result)
-> Result -> State (BackendState target) Result
forall a b. (a -> b) -> a -> b
$ [Result] -> Result
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Result
lexSpec, Result
parSpec, Result
parTest, Result
absSpec, Result
printSpec, Result
mkfile]