-- | -- Module: Parser.Generator -- Copyright: (c) 2015-2016 Martijn Rijkeboer -- License: MIT -- Maintainer: Martijn Rijkeboer -- -- Generator for the data types. module Parser.Generator ( generate ) where import Control.Monad.State (State, execState, get, put) import Data.List (foldl') import Data.List.Split (splitOn) import Parser.CodeInfo (CodeInfo(CodeInfo)) import Parser.EnumDesc (EnumDesc) import Parser.EnumGenerator (getEnumCode) import Parser.FileDesc (FileDesc) import Parser.GeneratorUtils ( MessageSet, EnumSet, GenState(GenState, codeInfos), getNamespace ) import Parser.MessageDesc (MessageDesc) import Parser.MessageGenerator (getMessageCode) import System.FilePath (joinPath) import qualified Data.Set as Set import qualified Parser.EnumDesc as EnumDesc import qualified Parser.FileDesc as FileDesc import qualified Parser.MessageDesc as MessageDesc generate :: [FileDesc] -> [CodeInfo] generate fs = codeInfos $ execState (mapM_ addFileCodeInfos fs) state where state = GenState fs [] mset eset mset = getMessageSet fs eset = getEnumSet fs addFileCodeInfos :: FileDesc -> State GenState () addFileCodeInfos f = do mapM_ (addMessageCodeInfo f) $ getMessageDescs f mapM_ (addEnumCodeInfo f) $ getEnumDescs f addMessageCodeInfo :: FileDesc -> MessageDesc -> State GenState () addMessageCodeInfo fd md = do state <- get fdirs <- getDirectories fd fname <- getMessageFilename md fcode <- getMessageCode fd md put $ state{codeInfos = CodeInfo fdirs fname fcode : codeInfos state} addEnumCodeInfo :: FileDesc -> EnumDesc -> State GenState () addEnumCodeInfo fd ed = do state <- get fdirs <- getDirectories fd fname <- getEnumFilename ed fcode <- getEnumCode fd ed put $ state{codeInfos = CodeInfo fdirs fname fcode : codeInfos state} getMessageDescs :: FileDesc -> [MessageDesc] getMessageDescs f = addMessageDescs [] $ FileDesc.getMessageDescs f addMessageDescs :: [MessageDesc] -> [MessageDesc] -> [MessageDesc] addMessageDescs = foldl' addMessageDesc addMessageDesc :: [MessageDesc] -> MessageDesc -> [MessageDesc] addMessageDesc mlist m = case MessageDesc.getMessageDescs m of [] -> m : mlist ns -> addMessageDescs (m : mlist) ns getEnumDescs :: FileDesc -> [EnumDesc] getEnumDescs f = insertSubEnums (insertEnums [] f) f where insertEnums elist fd = addEnumDescs elist (FileDesc.getEnumDescs fd) insertSubEnums elist fd = addSubEnumDescs elist (FileDesc.getMessageDescs fd) addEnumDescs :: [EnumDesc] -> [EnumDesc] -> [EnumDesc] addEnumDescs = foldl' addEnumDesc addEnumDesc :: [EnumDesc] -> EnumDesc -> [EnumDesc] addEnumDesc elist e = e : elist addSubEnumDescs :: [EnumDesc] -> [MessageDesc] -> [EnumDesc] addSubEnumDescs = foldl' addSubEnumDesc addSubEnumDesc :: [EnumDesc] -> MessageDesc -> [EnumDesc] addSubEnumDesc elist m = case MessageDesc.getMessageDescs m of [] -> case MessageDesc.getEnumDescs m of [] -> elist es -> addEnumDescs elist es ms -> case MessageDesc.getEnumDescs m of [] -> addSubEnumDescs elist ms es -> addSubEnumDescs (addEnumDescs elist es) ms getMessageSet :: [FileDesc] -> MessageSet getMessageSet = foldl' insertMany Set.empty where insertMany mset fd = foldl' (insertOne fd) mset $ getMessageDescs fd insertOne fd mset md = Set.insert (getFullMessageName fd md) mset getEnumSet :: [FileDesc] -> EnumSet getEnumSet = foldl' insertMany Set.empty where insertMany eset fd = foldl' (insertOne fd) eset $ getEnumDescs fd insertOne fd eset ed = Set.insert (getFullEnumName fd ed) eset getDirectories :: FileDesc -> State GenState FilePath getDirectories fd = case FileDesc.getPackage fd of Just val -> return $ joinPath $ splitOn "." val Nothing -> return $ FileDesc.getName fd getMessageFilename :: MessageDesc -> State GenState FilePath getMessageFilename md = return $ MessageDesc.getName md ++ ".hs" getEnumFilename :: EnumDesc -> State GenState FilePath getEnumFilename ed = return $ EnumDesc.getName ed ++ ".hs" getFullEnumName :: FileDesc -> EnumDesc -> String getFullEnumName fd ed = getNamespace fd ++ "." ++ EnumDesc.getName ed getFullMessageName :: FileDesc -> MessageDesc -> String getFullMessageName fd md = getNamespace fd ++ "." ++ MessageDesc.getName md