Merge pull request #4722 from JacquesCarette/cleanup-main

Cleaned up GOOLTest File

Author: JacquesCarette

code/drasil-code/lib/Language/Drasil/Code/FileData.hs

@@ -1,10 +1,11 @@
+{-# LANGUAGE  PatternSynonyms #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 -- | Defines the underlying data types used in the package extension.
 module Language.Drasil.Code.FileData (FileAndContents(filePath, fileDoc),
-  fileAndContents, hasPathAndDocToFileAndContents, PackageData(packageProg,
-  packageAux), packageData
-) where
+  fileAndContents, hasPathAndDocToFileAndContents,
+  PackageData(packageProg, packageAux), pattern PackageData
+  ) where
 
 import Text.PrettyPrint.HughesPJ (Doc, isEmpty)
 import Utils.Drasil (HasPathAndDoc(..))
@@ -26,6 +27,8 @@ hasPathAndDocToFileAndContents file = fileAndContents (getPath file) (getDoc fil
 -- | The underlying data type for packages in all renderers.
 data PackageData a = PackD {packageProg :: a, packageAux :: [FileAndContents]}
 
--- | Constructor for package data.
-packageData :: a -> [FileAndContents] -> PackageData a
-packageData p as = PackD p (filter (not . isEmpty . fileDoc) as)
+pattern PackageData :: a -> [FileAndContents] -> PackageData a
+pattern PackageData prog aux <- PackD prog aux
+  where
+    PackageData prog aux = PackD prog (filter (not . isEmpty . fileDoc) aux)
+{-# COMPLETE PackageData #-}

code/drasil-code/lib/Language/Drasil/Code/Imperative/GOOL/ClassInterface.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, PatternSynonyms #-}
 
 -- | Defines a package extension for GOOL, with functions for pairing a GOOL
 -- program with auxiliary, non-source-code files.
@@ -18,8 +18,8 @@ import Language.Drasil.Printers (PrintingInformation)
 
 import Language.Drasil (Expr)
 import Language.Drasil.Code.DataDesc (DataDesc)
-import Language.Drasil.Code.FileData (FileAndContents(..), PackageData,
-  fileAndContents, packageData)
+import Language.Drasil.Code.FileData (FileAndContents(..), fileAndContents,
+  PackageData, pattern PackageData)
 import Language.Drasil.Code.FileNames (sampleInputName)
 import Language.Drasil.Choices (Comments, ImplementationType, Verbosity)
 import Language.Drasil.Code.Imperative.WriteInput (makeInputFile)
@@ -57,7 +57,7 @@ class AuxiliarySym r where
   auxHelperDoc :: r Doc -> Doc
 
 package :: (Monad r) => ProgData -> [r FileAndContents] -> r (PackageData ProgData)
-package p = onCodeList (packageData p)
+package p = onCodeList (PackageData p)
 
 sampleInput :: (Applicative r) => PrintingInformation -> DataDesc -> [Expr] ->
   r FileAndContents

code/drasil-code/lib/Language/Drasil/GOOL.hs

@@ -1,13 +1,17 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 -- | Re-export code-related smart constructors for external code writing and generation.
 module Language.Drasil.GOOL (
   AuxiliarySym(..), package,
-  FileAndContents(..), PackageData(..),
+  FileAndContents(..), hasPathAndDocToFileAndContents,
+  PackageData(..), pattern PackageData,
   unPP, unJP, unCSP, unCPPP, unSP, unJLP
 ) where
 
 import Language.Drasil.Code.Imperative.GOOL.ClassInterface (AuxiliarySym(..),
   package)
-import Language.Drasil.Code.FileData (FileAndContents(..), PackageData(..))
+import Language.Drasil.Code.FileData (FileAndContents(..),
+  hasPathAndDocToFileAndContents, PackageData(..), pattern PackageData)
 
 import Language.Drasil.Code.Imperative.GOOL.LanguageRenderer.PythonRenderer (unPP)
 import Language.Drasil.Code.Imperative.GOOL.LanguageRenderer.JavaRenderer (unJP)

code/drasil-code/test/Main.hs

@@ -1,27 +1,29 @@
+{-# LANGUAGE PatternSynonyms, TupleSections #-}
+
 -- | Main module to gather all the GOOL tests and generate them.
 module Main (main) where
 
-import Drasil.GOOL (Label, OOProg, unJC, unPC, unCSC,
-  unCPPC, unSC, initialState, FileData(..), ProgData(..), ModData(..),
-  headers, sources, mainMod)
+import Drasil.GOOL (Label, OOProg, unJC, unPC, unCSC, unCPPC, unSC,
+  initialState, ProgData(..), headers, sources, mainMod)
 import qualified Drasil.GOOL as OO (unCI, ProgramSym(..))
 import Drasil.GProc (ProcProg, unJLC)
 import qualified Drasil.GProc as Proc (unCI, ProgramSym(..))
 
 import Language.Drasil.Code (ImplementationType(..), makeSds)
 import Language.Drasil.GOOL (AuxiliarySym(..), package,
-  FileAndContents(fileDoc), PackageData(..), unPP, unJP, unCSP, unCPPP, unSP,
-  unJLP)
-import qualified Language.Drasil.GOOL as D (filePath)
+  hasPathAndDocToFileAndContents, PackageData(..), pattern PackageData,
+  unPP, unJP, unCSP, unCPPP, unSP, unJLP)
+import qualified Language.Drasil.GOOL as D (filePath, FileAndContents(..))
 
-import Utils.Drasil (createDirIfMissing)
+import Utils.Drasil (createDirIfMissing, createFile)
 
-import Text.PrettyPrint.HughesPJ (Doc, render)
+import Text.PrettyPrint.HughesPJ (render)
 import Control.Monad.State (evalState, runState)
 import Control.Lens ((^.))
+import Data.Functor ((<&>))
+import Data.Foldable (traverse_)
 import System.Directory (setCurrentDirectory, getCurrentDirectory)
-import System.FilePath.Posix (takeDirectory)
-import System.IO (hClose, hPutStrLn, openFile, IOMode(WriteMode))
+import System.FilePath ((</>))
 import Prelude hiding (return,print,log,exp,sin,cos,tan)
 
 import HelloWorld (helloWorldOO, helloWorldProc)
@@ -62,14 +64,14 @@ main = do
 
 -- | Gathers all information needed to generate code, sorts it, and calls the renderers.
 genCode :: [PackageData ProgData] -> IO()
-genCode files = createCodeFiles (concatMap (\p -> replicate (length (progMods
-  (packageProg p)) + length (packageAux p)) (progName $ packageProg p)) files) $
-    makeCode (map (progMods . packageProg) files) (map packageAux files)
+genCode files =
+  createCodeFiles $ files >>= \(PackageData prog aux) ->
+    let label = progName prog
+        modCode = progMods prog <&> \modFileData ->
+          (label, hasPathAndDocToFileAndContents modFileData)
+        auxCode = aux <&> (label,)
+    in modCode ++ auxCode
 
--- Cannot assign the list of tests in a where clause and re-use it because the
--- "r" type variable needs to be instantiated to two different types
--- (CodeInfo and a renderer) each time this function is called
--- | Gathers the GOOL file tests and prepares them for rendering
 classes :: (OOProg r, AuxiliarySym r', Monad r') => (r (OO.Program r) -> ProgData) ->
   (r' (PackageData ProgData) -> PackageData ProgData) -> [PackageData ProgData]
 classes unRepr unRepr' = zipWith
@@ -95,31 +97,12 @@ jlClasses unRepr unRepr' = zipWith
   (map (Proc.unCI . (`evalState` initialState)) [helloWorldProc,
     fileTestsProc, vectorTestProc, nameGenTestProc])
 
--- | Formats code to be rendered.
-makeCode :: [[FileData]] -> [[FileAndContents]] -> [(FilePath, Doc)]
-makeCode files auxs = concat $ zipWith (++)
-  (map (map (\fd -> (filePath fd, modDoc $ fileMod fd))) files)
-  (map (map (\fileAndContents ->
-      (D.filePath fileAndContents, fileDoc fileAndContents))) auxs)
-
-  -- zip (map filePath files) (map (modDoc . fileMod) files)
-  -- ++ zip (map D.filePath auxs) (map fileDoc auxs)
-
 ------------------
 -- IO Functions --
 ------------------
 
 -- | Creates the requested 'Code' by producing files.
-createCodeFiles :: [Label] -> [(FilePath, Doc)] -> IO () -- [(FilePath, Doc)] -> IO ()
-createCodeFiles ns cs = mapM_ createCodeFile (zip ns cs)
-
--- | Helper that creates the file and renders code.
-createCodeFile :: (Label, (FilePath, Doc)) -> IO ()
-createCodeFile (n, (path, code)) = do
-    createDirIfMissing False n
-    setCurrentDirectory n
-    createDirIfMissing True (takeDirectory path)
-    h <- openFile path WriteMode
-    hPutStrLn h (render code)
-    hClose h
-    setCurrentDirectory ".."
+createCodeFiles :: [(Label, D.FileAndContents)] -> IO ()
+createCodeFiles = traverse_ $ \(name, file) -> do
+  let path = name </> D.filePath file -- FIXME [Brandon Bosman, Feb. 10, 2026]: make GOOL allow us to add name to path internally
+  createFile path (render $ D.fileDoc file)