{-# LANGUAGE FlexibleInstances #-}

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

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

import Control.Arrow    ( (&&&) )
import Control.Monad.IO.Class ( liftIO )
import Control.Monad.Writer   ( WriterT, execWriterT, tell )

import Data.Char        ( isSpace )
import Data.Foldable    ( forM_ )
import Data.Function    ( on )
import qualified Data.List as List

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

import BNFC.Options     ( versionString )
import BNFC.PrettyPrint
import BNFC.Utils       ( writeFileRep )

-- | Stamp BNFC puts in the header of each generated file.
msgGenerated :: String
msgGenerated :: String
msgGenerated = String
"File generated by the BNF Converter (bnfc " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
versionString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")."

-- | 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 [GeneratedFile] IO a
type Backend = MkFiles ()

-- | A result file of a backend.
data GeneratedFile = GeneratedFile
  { GeneratedFile -> String
fileName    :: FilePath
      -- ^ Name of the file to write.
  , GeneratedFile -> String -> String
makeComment :: MakeComment
      -- ^ Function to generate a comment.
      --   Used to prefix the file with a stamp ("Generated by BNFC").
  , GeneratedFile -> String
fileContent :: String
      -- ^ Content of the file to write.
  }

-- quick-and-dirty instances for HSpec test-suite

instance Show GeneratedFile where
  show :: GeneratedFile -> String
show (GeneratedFile String
x String -> String
_  String
y) = [String] -> String
unwords [ String
"GeneratedFile", String -> String
forall a. Show a => a -> String
show String
x, String
"_", String -> String
forall a. Show a => a -> String
show String
y ]

instance Eq GeneratedFile where
  == :: GeneratedFile -> GeneratedFile -> Bool
(==) = (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((String, String) -> (String, String) -> Bool)
-> (GeneratedFile -> (String, String))
-> GeneratedFile
-> GeneratedFile
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GeneratedFile -> String
fileName (GeneratedFile -> String)
-> (GeneratedFile -> String) -> GeneratedFile -> (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GeneratedFile -> String
fileContent

-- | Type of comment-generating functions.
type MakeComment = String -> String

-- | Named after execWriter, this function execute the given backend
-- and returns the generated file paths and contents.
execBackend :: MkFiles () -> IO [GeneratedFile]
execBackend :: MkFiles () -> IO [GeneratedFile]
execBackend = MkFiles () -> IO [GeneratedFile]
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 -> MakeComment -> c -> MkFiles ()
mkfile :: String -> (String -> String) -> c -> MkFiles ()
mkfile String
path String -> String
f c
content = [GeneratedFile] -> MkFiles ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String -> (String -> String) -> String -> GeneratedFile
GeneratedFile String
path String -> String
f (c -> String
forall a. FileContent a => a -> String
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 :: String -> String
fileContentToString = String -> String
deleteTrailingWhiteSpace

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

deleteTrailingWhiteSpace :: String -> String
deleteTrailingWhiteSpace :: String -> String
deleteTrailingWhiteSpace = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
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 :: String -> MkFiles () -> IO ()
writeFiles String
root MkFiles ()
fw = do
  -- First we check that the directory exists.
  [GeneratedFile]
fb <- MkFiles () -> IO [GeneratedFile]
execBackend MkFiles ()
fw
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
root
  [GeneratedFile] -> (GeneratedFile -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GeneratedFile]
fb ((GeneratedFile -> IO ()) -> IO ())
-> (GeneratedFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (GeneratedFile String
path String -> String
mkComment String
content) -> do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
root String -> String -> String
</> String -> String
dropFileName String
path)
     -- Then we write the files, adding the BNFC stamp as header.
    String -> String -> IO ()
writeFileRep (String
root String -> String -> String
</> String
path) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      -- TODO: the following is a hack, make this more systematic:
      if String -> String
takeExtension String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".txt" then
        -- Sign at the end since e.g. txt2tags cannot handle comments at beginning of file.
        [String] -> String
unlines [ String
content, String -> String
mkComment String
msgGenerated ]
      else
        -- Sign at the beginning (JFlex cannot handle comments in general, only at beginning).
        String -> String
mkComment String
msgGenerated String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
content