Skip to content
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 10 additions & 6 deletions code/drasil-code/lib/Language/Drasil/Code/FileData.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
{-# LANGUAGE PatternSynonyms #-}

-- | Defines the underlying data types used in the package extension.
module Language.Drasil.Code.FileData (FileAndContents(filePath, fileDoc),
fileAndContents, fileDataToFileAndContents, PackageData(packageProg,
packageAux), packageData
) where
fileAndContents, fileDataToFileAndContents,
PackageData(packageProg, packageAux), pattern PackageData
) where

import Text.PrettyPrint.HughesPJ (Doc, isEmpty)
import qualified Drasil.GOOL as G (FileData(..), ModData(..))
Expand All @@ -20,6 +22,8 @@ fileDataToFileAndContents file = fileAndContents (G.filePath file) ((G.modDoc .
-- | 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 #-}
Original file line number Diff line number Diff line change
@@ -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.
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
8 changes: 6 additions & 2 deletions code/drasil-code/lib/Language/Drasil/GOOL.hs
Original file line number Diff line number Diff line change
@@ -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(..), fileDataToFileAndContents,
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(..),
fileDataToFileAndContents, PackageData(..), pattern PackageData)

import Language.Drasil.Code.Imperative.GOOL.LanguageRenderer.PythonRenderer (unPP)
import Language.Drasil.Code.Imperative.GOOL.LanguageRenderer.JavaRenderer (unJP)
Expand Down
64 changes: 29 additions & 35 deletions code/drasil-code/test/Main.hs
Original file line number Diff line number Diff line change
@@ -1,24 +1,27 @@
{-# 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)
fileDataToFileAndContents, PackageData(..), pattern PackageData, unPP, unJP,
unCSP, unCPPP, unSP, unJLP)
import qualified Language.Drasil.GOOL as D (filePath, FileAndContents(..))

import Utils.Drasil (createDirIfMissing)

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))
Expand Down Expand Up @@ -62,14 +65,13 @@ 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 =
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

much nicer!

createCodeFiles $ files >>= \(PackageData prog aux) ->
let label = progName prog
modCode = progMods prog <&> \modFileData -> (label, fileDataToFileAndContents 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
Expand All @@ -95,31 +97,23 @@ 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)
createCodeFiles :: [(Label, D.FileAndContents)] -> IO ()
createCodeFiles = traverse_ createCodeFile

-- | 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 ".."
createCodeFile :: (Label, D.FileAndContents) -> IO ()
createCodeFile (n, file) = do
let path = D.filePath file
code = D.fileDoc file
createDirIfMissing False n
setCurrentDirectory n
createDirIfMissing True (takeDirectory path)
h <- openFile path WriteMode
hPutStrLn h (render code)
hClose h
setCurrentDirectory ".."