{-# 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.Writer

import Data.Char        ( isSpace )
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 :: [Char]
msgGenerated = [Char]
"File generated by the BNF Converter (bnfc " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
versionString [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")."

-- | 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 -> [Char]
fileName    :: FilePath
      -- ^ Name of the file to write.
  , GeneratedFile -> [Char] -> [Char]
makeComment :: MakeComment
      -- ^ Function to generate a comment.
      --   Used to prefix the file with a stamp ("Generated by BNFC").
  , GeneratedFile -> [Char]
fileContent :: String
      -- ^ Content of the file to write.
  }

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

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

instance Eq GeneratedFile where
  == :: GeneratedFile -> GeneratedFile -> Bool
(==) = ([Char], [Char]) -> ([Char], [Char]) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (([Char], [Char]) -> ([Char], [Char]) -> Bool)
-> (GeneratedFile -> ([Char], [Char]))
-> GeneratedFile
-> GeneratedFile
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GeneratedFile -> [Char]
fileName (GeneratedFile -> [Char])
-> (GeneratedFile -> [Char]) -> GeneratedFile -> ([Char], [Char])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GeneratedFile -> [Char]
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 :: forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile [Char]
path [Char] -> [Char]
f c
content = [GeneratedFile] -> MkFiles ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char] -> ([Char] -> [Char]) -> [Char] -> GeneratedFile
GeneratedFile [Char]
path [Char] -> [Char]
f (c -> [Char]
forall a. FileContent a => a -> [Char]
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 :: [Char] -> [Char]
fileContentToString = [Char] -> [Char]
deleteTrailingWhiteSpace

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

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