-- |Cabal utilities for XDR processing.
{-# LANGUAGE CPP #-}
module Network.ONCRPC.XDR.Cabal
  ( ppRPCGenSuffixHandler
  ) where

import           Data.Char (toLower)
import           Data.List (intercalate, isPrefixOf)
import           Data.Maybe (fromMaybe, mapMaybe)
import           Distribution.PackageDescription (BuildInfo(customFieldsBI))
import           Distribution.Verbosity (Verbosity)
import           Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
import           Distribution.Simple.PreProcess (PreProcessor(..), PPSuffixHandler)
import           Distribution.Simple.Utils (info)
#if MIN_VERSION_Cabal(2,0,0)
import           Distribution.Types.ComponentLocalBuildInfo (ComponentLocalBuildInfo)
#endif
import           System.FilePath ((</>), dropExtension, splitDirectories)

import           Network.ONCRPC.XDR.Generate

runRPCGen :: [(String, String)] -> (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()
runRPCGen :: [(String, String)]
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runRPCGen [(String, String)]
custom (String
indir, String
infile) (String
outdir, String
outfile) Verbosity
verb = do
  Verbosity -> String -> IO ()
info Verbosity
verb forall a b. (a -> b) -> a -> b
$ String
"hdrpcgen " forall a. [a] -> [a] -> [a]
++ String
inpath forall a. [a] -> [a] -> [a]
++ String
" with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GenerateOptions
opts
  String -> String -> IO ()
writeFile String
outpath
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenerateOptions -> String -> IO String
generateFromFile GenerateOptions
opts String
inpath
  where
  opts :: GenerateOptions
opts = GenerateOptions
    { generateModuleName :: String
generateModuleName = String
modname
    , generateReidentOptions :: ReidentOptions
generateReidentOptions = ReidentOptions
      { reidentUpperPrefix :: String
reidentUpperPrefix = forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ String -> Maybe String
opt String
"upper-prefix"
      , reidentLowerPrefix :: String
reidentLowerPrefix = forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ String -> Maybe String
opt String
"lower-prefix"
      , reidentJoinField :: Maybe String
reidentJoinField = String -> Maybe String
joinopt String
"field"
      , reidentJoinProcedure :: Maybe String
reidentJoinProcedure = String -> Maybe String
joinopt String
"procedure"
      }
    }
  joinopt :: String -> Maybe String
joinopt String
t = case (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
boolish forall a b. (a -> b) -> a -> b
$ String -> Maybe String
opt forall a b. (a -> b) -> a -> b
$ String
t forall a. [a] -> [a] -> [a]
++ String
"s-unique", String -> Maybe String
opt forall a b. (a -> b) -> a -> b
$ String
"join-" forall a. [a] -> [a] -> [a]
++ String
t) of
    (Bool
False, Maybe String
j) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"'" Maybe String
j
    (Bool
True, Maybe String
Nothing) -> forall a. Maybe a
Nothing
    (Bool
True, Just String
_) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"x-rpcgen join and unique options are mutually exclusive"
  boolish :: String -> Bool
boolish String
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"true"
  opt :: String -> Maybe String
opt String
f = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
f [(String, String)]
custom
  inpath :: String
inpath = String
indir String -> String -> String
</> String
infile
  outpath :: String
outpath = String
outdir String -> String -> String
</> String
outfile
  modname :: String
modname = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
infile

ppRPCGenCustomField :: (String, String) -> Maybe (String, String)
ppRPCGenCustomField :: (String, String) -> Maybe (String, String)
ppRPCGenCustomField (Char
'x':Char
'-':Char
'r':Char
'p':Char
'c':Char
'g':Char
'e':Char
'n':Char
'-':String
f,String
v) = forall a. a -> Maybe a
Just (String
f,String
v)
ppRPCGenCustomField (String, String)
_ = forall a. Maybe a
Nothing

ppRPCGen :: BuildInfo -> LocalBuildInfo
#if MIN_VERSION_Cabal(2,0,0)
  -> ComponentLocalBuildInfo
#endif
  -> PreProcessor
ppRPCGen :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppRPCGen BuildInfo
bi LocalBuildInfo
_ 
#if MIN_VERSION_Cabal(2,0,0)
  ComponentLocalBuildInfo
_
#endif
  = PreProcessor
  { platformIndependent :: Bool
platformIndependent = Bool
True
  , runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = [(String, String)]
-> (String, String) -> (String, String) -> Verbosity -> IO ()
runRPCGen forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, String) -> Maybe (String, String)
ppRPCGenCustomField forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
bi
  }

-- |Pre-processor for hsrpcgen.
-- You can use it by setting @'Distributin.Simple.UserHooks' { 'Distributin.Simple.hookedPrepProcessors' = ['ppRPCGenSuffixHandler'] }@.
-- Note that this will override the default alex @.x@ file handler.
-- You can also specify custom cabal fields corresponding to 'ReidentOptions' and command-line flags prefixed with @x-rpcgen-@: @{upper,lower}-prefix@, @join-{field,procedure}@, and @{field,procedure}s-unique}@.
ppRPCGenSuffixHandler :: PPSuffixHandler
ppRPCGenSuffixHandler :: PPSuffixHandler
ppRPCGenSuffixHandler = (String
"x", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppRPCGen)