module DatabaseDesign.Ampersand.Components
(
makeFspec
, generateAmpersandOutput
, Guarded(..)
)
where
import Prelude hiding (putStr,readFile,writeFile)
import DatabaseDesign.Ampersand.Misc
import DatabaseDesign.Ampersand.ADL1.P2A_Converters
import Text.Pandoc
import Text.Pandoc.Builder
import DatabaseDesign.Ampersand.Basics
import DatabaseDesign.Ampersand.Fspec
import DatabaseDesign.Ampersand.Fspec.GenerateUML
import DatabaseDesign.Ampersand.Fspec.ShowXMLtiny (showXML)
import DatabaseDesign.Ampersand.Output
import Control.Monad
import System.FilePath
fatal :: Int -> String -> a
fatal = fatalMsg "Components"
generateAmpersandOutput :: Options -> Fspc -> IO ()
generateAmpersandOutput flags fSpec =
do { verboseLn flags "Generating common Ampersand artifacts..."
; when (genXML flags) $ doGenXML fSpec flags
; when (genUML flags) $ doGenUML fSpec flags
; when (haskell flags) $ doGenHaskell fSpec flags
; when (export2adl flags) $ doGenADL fSpec flags
; when (genFspec flags) $ doGenDocument fSpec flags
; when (genFPAExcel flags) $ doGenFPAExcel fSpec flags
; when (proofs flags) $ doGenProofs fSpec flags
; when (genMeat flags && (not . includeRap) flags)
$ doGenMeatGrinder fSpec flags
; verboseLn flags "Done."
}
doGenADL :: Fspc -> Options -> IO()
doGenADL fSpec flags =
do { writeFile outputFile (showADL fSpec)
; verboseLn flags $ ".adl-file written to " ++ outputFile ++ "."
}
where outputFile = combine (dirOutput flags) (outputfile flags)
doGenProofs :: Fspc -> Options -> IO()
doGenProofs fSpec flags =
do { verboseLn flags $ "Generating Proof for " ++ name fSpec ++ " into " ++ outputFile ++ "."
; writeFile outputFile $ writeHtmlString def thePandoc
; verboseLn flags "Proof written."
}
where outputFile = combine (dirOutput flags) $ replaceExtension ("proofs_of_"++baseName flags) ".html"
thePandoc = setTitle title (doc theDoc)
title = text $ "Proofs for "++name fSpec
theDoc = deriveProofs flags fSpec
doGenHaskell :: Fspc -> Options -> IO()
doGenHaskell fSpec flags =
do { verboseLn flags $ "Generating Haskell source code for "++name fSpec
; writeFile outputFile (fSpec2Haskell fSpec flags)
; verboseLn flags $ "Haskell written into " ++ outputFile ++ "."
}
where outputFile = combine (dirOutput flags) $ replaceExtension (baseName flags) ".hs"
doGenMeatGrinder :: Fspc -> Options -> IO()
doGenMeatGrinder fSpec flags =
do verboseLn flags $ "Generating meta-population for "++name fSpec
let (nm,content) = meatGrinder flags fSpec
outputFile = combine (dirOutput flags) $ replaceExtension nm ".adl"
writeFile outputFile content
verboseLn flags $ "Meta population written into " ++ outputFile ++ "."
doGenXML :: Fspc -> Options -> IO()
doGenXML fSpec flags =
do { verboseLn flags "Generating XML..."
; writeFile outputFile $ showXML fSpec (genTime flags)
; verboseLn flags $ "XML written into " ++ outputFile ++ "."
}
where outputFile = combine (dirOutput flags) $ replaceExtension (baseName flags) ".xml"
doGenUML :: Fspc -> Options -> IO()
doGenUML fSpec flags =
do { verboseLn flags "Generating UML..."
; writeFile outputFile $ generateUML fSpec flags
; Prelude.putStrLn $ "Generated file: " ++ outputFile ++ "."
}
where outputFile = combine (dirOutput flags) $ replaceExtension (baseName flags) ".xmi"
doGenDocument :: Fspc -> Options -> IO()
doGenDocument fSpec flags =
do { verboseLn flags ("Processing "++name fSpec)
; makeOutput
; verboseLn flags $ "Document has been written to " ++ outputFile ++ "."
; when (genGraphics flags && not(null thePictures) && fspecFormat flags/=FPandoc) $
mapM_ (writePicture flags) thePictures
; postProcessor
}
where (thePandoc,thePictures) =
case (theme flags, fspecFormat flags) of
(ProofTheme, _ ) -> fatal 116 "Ampersand only supports proof documents output in LaTeX format. try `-fLatex` "
(_ , _ ) -> fSpec2Pandoc fSpec flags
(outputFile,makeOutput,postProcessor) = writepandoc flags fSpec thePandoc
doGenFPAExcel :: Fspc -> Options -> IO()
doGenFPAExcel fSpec flags =
do { verboseLn flags "Generating Excel..."
; writeFile outputFile (showSpreadsheet (fspec2Workbook fSpec flags))
}
where outputFile = combine (dirOutput flags) $ replaceExtension ("FPA_"++baseName flags) ".xml"