{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

-- | Backend base module.
--
-- Defines the type of the backend and some useful functions.

module BNFC.Backend.Base
  ( Backend
  , MkFiles
  , execBackend
  , mkfile
  , liftIO
  , writeFiles
  ) where

import Control.Monad.Writer

import Data.Char (isSpace)
import qualified Data.List as List

import System.Directory (createDirectoryIfMissing)
import System.FilePath (dropFileName, (</>))

import BNFC.PrettyPrint
import BNFC.Utils (writeFileRep)

-- | Define the type of the backend functions For more purity, instead of
-- having each backend writing the generated files to disk, they return a list
-- of pairs containing the (relative) file path and the file content. This
-- allow for 1) easier testing, 2) implement common options like changing the
-- output dir or providing a diff instead of overwritting the files on a
-- highter level and 3) more purity.
--
-- The writer monad provides a more convenient API to generate the list. Note
-- that we still use the `IO` monad for now because some backends insist on
-- printing stuff to the screen while generating the files.
type MkFiles a = WriterT [(FilePath, String)] IO a
type Backend = MkFiles ()


-- | Named after execWriter, this function execute the given backend
-- and returns the generated file paths and contents.
execBackend :: MkFiles () -> IO [(FilePath, String)]
execBackend :: MkFiles () -> IO [(FilePath, FilePath)]
execBackend = MkFiles () -> IO [(FilePath, FilePath)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT

-- | A specialized version of `tell` that adds a file and its content to the
-- list of generated files.
mkfile :: (FileContent c) => FilePath -> c -> MkFiles ()
mkfile :: FilePath -> c -> MkFiles ()
mkfile FilePath
path c
content = [(FilePath, FilePath)] -> MkFiles ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(FilePath
path, c -> FilePath
forall a. FileContent a => a -> FilePath
fileContentToString c
content)]

-- | While we are moving to generating `Text.PrettyPrint.Doc` instead of `String`,
-- it is nice to be able to use both as argument to 'mkfile'.
-- So we do some typeclass magic.
class FileContent a where
    fileContentToString :: a -> String

instance FileContent [Char] where
    fileContentToString :: FilePath -> FilePath
fileContentToString = FilePath -> FilePath
deleteTrailingWhiteSpace

instance FileContent Doc where
    fileContentToString :: Doc -> FilePath
fileContentToString = FilePath -> FilePath
deleteTrailingWhiteSpace (FilePath -> FilePath) -> (Doc -> FilePath) -> Doc -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
render

deleteTrailingWhiteSpace :: String -> String
deleteTrailingWhiteSpace :: FilePath -> FilePath
deleteTrailingWhiteSpace = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines

-- | Write a set of files to disk. the first argument is the root directory
-- inside which all the generated files will be written. This root directory
-- and sub-directories will be created as needed (ex: if the files contains a
-- @a\/b\/file.txt@, `writeFiles` will create the directories @$ROOT\/a@ and
-- @$ROOT\/a\/b@)
writeFiles :: FilePath -> MkFiles () -> IO ()
writeFiles :: FilePath -> MkFiles () -> IO ()
writeFiles FilePath
root MkFiles ()
fw = do
  -- First we check that the directory exists
  [(FilePath, FilePath)]
fb <- MkFiles () -> IO [(FilePath, FilePath)]
execBackend MkFiles ()
fw
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
root
  ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
writeFile') [(FilePath, FilePath)]
fb
  where
  writeFile' :: FilePath -> String -> IO ()
  writeFile' :: FilePath -> FilePath -> IO ()
writeFile' FilePath
path FilePath
content = do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropFileName FilePath
path)
    FilePath -> FilePath -> IO ()
writeFileRep (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
path) FilePath
content