Class.hs

{-# LANGUAGE Haskell2010
    , GeneralizedNewtypeDeriving
 #-}
{-# OPTIONS -Wall #-}

module CodeGen.Class where

import Types

import Control.Monad.Reader

import qualified Haskell.X as X

type CodeGenerator m = CodeGen m String

newtype CodeGen m a = CodeGen { _runBG :: ReaderT ClassInfo m a }
  deriving (Monad, MonadReader ClassInfo, Functor)


gen :: Monad m => ClassInfo -> CodeGenerator m -> m String
gen info generator = runReaderT (_runBG generator) info


getModNameForClass :: Monad m => String -> CodeGen m String
getModNameForClass clazz = do
    info <- ask
    return $ info `classModName` clazz
    
getModNameForPackage :: Monad m => String -> CodeGen m String
getModNameForPackage package = do
    info <- ask
    return $ info `packageModName` package

getClassInfoFor :: Monad m => String -> CodeGen m JavaClass
getClassInfoFor clazz = do
    info <- ask
    return $ info `aboutClass` clazz

getClassInfoFunc :: Monad m => CodeGen m (String -> JavaClass)
getClassInfoFunc = ask >>= return . aboutClass

getClassModFunc :: Monad m => CodeGen m (JavaClass -> String)
getClassModFunc = do
    info <- ask
    return (classModName info . className)

getClasses :: Monad m => CodeGen m [String]
getClasses = do
    info <- ask
    return $ allClasses info

getPackages :: Monad m => CodeGen m [String]
getPackages = do
    info <- ask
    return $ allPackages info

getClassesForPackage :: Monad m => String -> CodeGen m [String]
getClassesForPackage package = do
    info <- ask
    return $ info `classesForPackage` package

getPackageModuleDeps :: Monad m => String -> CodeGen m [String]
getPackageModuleDeps package = getClassesForPackage package >>= getClassModulesUniq

getClassModules :: Monad m => [String] -> CodeGen m [String]
getClassModules = mapM getModNameForClass

getClassModulesUniq :: Monad m => [String] -> CodeGen m [String]
getClassModulesUniq classes = return (X.uniqSort classes) >>= getClassModules

getClassModuleDeps :: Monad m => JavaClass -> CodeGen m [String]
getClassModuleDeps clazz = getClassModulesUniq (className clazz : classDependencies clazz)