gidl/src/Gidl/Backend/Ivory.hs

module Gidl.Backend.Ivory where

import Ivory.Artifact
import Ivory.Artifact.Template

import Data.Char (isSpace)
import Data.List (intercalate, nub)

import qualified Paths_gidl as P

import Gidl.Interface
import Gidl.Schema
import Gidl.Backend.Cabal
import Gidl.Backend.Ivory.Types
import Gidl.Backend.Ivory.Schema

ivoryBackend :: [Interface] -> String -> String -> [Artifact]
ivoryBackend iis pkgname namespace_raw =
  [ cabalFileArtifact cf
  , artifactPath "tests" $ codegenTest namespace
  , makefile
  ] ++ map (artifactPath "src") sources
  where
  sources = ivorySources iis namespace
  namespace = dotwords namespace_raw

  cf = (defaultCabalFile pkgname cabalmods deps) { executables = [ cg_exe ] }
  cg_exe = defaultCabalExe (pkgname ++ "-gen") "CodeGen.hs"
              (deps ++ (words "ivory-backend-c") ++ [pkgname])
  cabalmods = map (filePathToPackage . artifactFileName) sources
  deps = words "ivory ivory-stdlib ivory-serialize"



ivorySources :: [Interface] -> [String] -> [Artifact]
ivorySources iis namespace =
  tmods ++ concat smods ++ [ typeUmbrella namespace userDefinedTypes
                           , unpackModule namespace
                           ]
  where
  userDefinedTypes = nub [ t | i <- iis, t <- interfaceTypes i, isUserDefined t ]
  tmods = [ typeModule (namespace ++ ["Types"]) t
          | t <- userDefinedTypes ]
  smods = [ [ schemaModule (namespace ++ ["Interface"]) i (producerSchema i)
            , schemaModule (namespace ++ ["Interface"]) i (consumerSchema i) ]
          | i <- iis ]

dotwords :: String -> [String]
dotwords s = case dropWhile isDot s of
  "" -> []
  s' -> let  (w, s'') = break isDot s' in w : dotwords s''
  where
  isDot c = (c == '.') || isSpace c

makefile :: Artifact
makefile = artifactCabalFile P.getDataDir "support/ivory/Makefile"

codegenTest :: [String] -> Artifact
codegenTest modulepath =
  artifactCabalFileTemplate P.getDataDir fname
    [("module_path", intercalate "." modulepath )]
  where
  fname = "support/ivory/CodeGen.hs.template"

unpackModule :: [String] -> Artifact
unpackModule modulepath =
  artifactPath (intercalate "/" modulepath) $
  artifactCabalFileTemplate P.getDataDir fname
    [("module_path", intercalate "." modulepath )]
  where
  fname = "support/ivory/Unpack.hs.template"