diff --git a/code/drasil-code/lib/Language/Drasil/Code/FileData.hs b/code/drasil-code/lib/Language/Drasil/Code/FileData.hs index 59fbbee486..df6183a6d9 100644 --- a/code/drasil-code/lib/Language/Drasil/Code/FileData.hs +++ b/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 #-} diff --git a/code/drasil-code/lib/Language/Drasil/Code/Imperative/GOOL/ClassInterface.hs b/code/drasil-code/lib/Language/Drasil/Code/Imperative/GOOL/ClassInterface.hs index 3fd745f8c2..9f80c98eb2 100644 --- a/code/drasil-code/lib/Language/Drasil/Code/Imperative/GOOL/ClassInterface.hs +++ b/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 diff --git a/code/drasil-code/lib/Language/Drasil/GOOL.hs b/code/drasil-code/lib/Language/Drasil/GOOL.hs index 6c199fb99a..3ba572f762 100644 --- a/code/drasil-code/lib/Language/Drasil/GOOL.hs +++ b/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) diff --git a/code/drasil-code/test/Main.hs b/code/drasil-code/test/Main.hs index 674d3c79d3..54bd057f2c 100644 --- a/code/drasil-code/test/Main.hs +++ b/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)