{-# LANGUAGE FlexibleInstances #-}
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 )
msgGenerated :: String
msgGenerated :: [Char]
msgGenerated = [Char]
"File generated by the BNF Converter (bnfc " forall a. [a] -> [a] -> [a]
++ [Char]
versionString forall a. [a] -> [a] -> [a]
++ [Char]
")."
type MkFiles a = WriterT [GeneratedFile] IO a
type Backend = MkFiles ()
data GeneratedFile = GeneratedFile
{ GeneratedFile -> [Char]
fileName :: FilePath
, :: MakeComment
, GeneratedFile -> [Char]
fileContent :: String
}
instance Show GeneratedFile where
show :: GeneratedFile -> [Char]
show (GeneratedFile [Char]
x MakeComment
_ [Char]
y) = [[Char]] -> [Char]
unwords [ [Char]
"GeneratedFile", forall a. Show a => a -> [Char]
show [Char]
x, [Char]
"_", forall a. Show a => a -> [Char]
show [Char]
y ]
instance Eq GeneratedFile where
== :: GeneratedFile -> GeneratedFile -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GeneratedFile -> [Char]
fileName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GeneratedFile -> [Char]
fileContent
type = String -> String
execBackend :: MkFiles () -> IO [GeneratedFile]
execBackend :: MkFiles () -> IO [GeneratedFile]
execBackend = forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT
mkfile :: FileContent c => FilePath -> MakeComment -> c -> MkFiles ()
mkfile :: forall c. FileContent c => [Char] -> MakeComment -> c -> MkFiles ()
mkfile [Char]
path MakeComment
f c
content = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char] -> MakeComment -> [Char] -> GeneratedFile
GeneratedFile [Char]
path MakeComment
f (forall a. FileContent a => a -> [Char]
fileContentToString c
content)]
class FileContent a where
fileContentToString :: a -> String
instance FileContent [Char] where
fileContentToString :: MakeComment
fileContentToString = MakeComment
deleteTrailingWhiteSpace
instance FileContent Doc where
fileContentToString :: Doc -> [Char]
fileContentToString = MakeComment
deleteTrailingWhiteSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
render
deleteTrailingWhiteSpace :: String -> String
deleteTrailingWhiteSpace :: MakeComment
deleteTrailingWhiteSpace = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
writeFiles :: FilePath -> MkFiles () -> IO ()
writeFiles :: [Char] -> MkFiles () -> IO ()
writeFiles [Char]
root MkFiles ()
fw = do
[GeneratedFile]
fb <- MkFiles () -> IO [GeneratedFile]
execBackend MkFiles ()
fw
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
root
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GeneratedFile]
fb forall a b. (a -> b) -> a -> b
$ \ (GeneratedFile [Char]
path MakeComment
mkComment [Char]
content) -> do
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char]
root [Char] -> MakeComment
</> MakeComment
dropFileName [Char]
path)
[Char] -> [Char] -> IO ()
writeFileRep ([Char]
root [Char] -> MakeComment
</> [Char]
path) forall a b. (a -> b) -> a -> b
$
if MakeComment
takeExtension [Char]
path forall a. Eq a => a -> a -> Bool
== [Char]
".txt" then
[[Char]] -> [Char]
unlines [ [Char]
content, MakeComment
mkComment [Char]
msgGenerated ]
else
MakeComment
mkComment [Char]
msgGenerated forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n" forall a. [a] -> [a] -> [a]
++ [Char]
content