Generator.hs

-- |
-- Module:      Parser.Generator
-- Copyright:   (c) 2015-2016 Martijn Rijkeboer <mrr@sru-systems.com>
-- License:     MIT
-- Maintainer:  Martijn Rijkeboer <mrr@sru-systems.com>
--
-- 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
import Parser.EnumDesc (EnumDesc)
import Parser.EnumGenerator (getEnumCode)
import Parser.FileDesc (FileDesc)
import Parser.GeneratorUtils
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 = case FileDesc.getPackage fd of
    Just val -> val ++ "." ++ name
    Nothing  -> name
  where name = EnumDesc.getName ed


getFullMessageName :: FileDesc -> MessageDesc -> String
getFullMessageName fd md = case FileDesc.getPackage fd of
    Just val -> val ++ "." ++ name
    Nothing  -> name
  where name = MessageDesc.getName md