{-# LANGUAGE CPP #-}
module Foreign.Hoppy.Generator.Main (
Action (..),
EnumEvalCacheMode (..),
defaultMain,
defaultMain',
ensureInterfaces,
run,
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Arrow ((&&&))
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, readMVar)
import Control.Monad ((<=<), forM, unless, when)
import Data.Foldable (forM_)
import Data.List (intercalate)
import qualified Data.Map as M
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Foreign.Hoppy.Generator.Common (fromMaybeM, writeFileIfDifferent)
import Foreign.Hoppy.Generator.Hook (internalEvaluateEnumsForInterface)
import qualified Foreign.Hoppy.Generator.Language.Cpp as Cpp
import qualified Foreign.Hoppy.Generator.Language.Cpp.Internal as Cpp
import qualified Foreign.Hoppy.Generator.Language.Haskell.Internal as Haskell
import Foreign.Hoppy.Generator.Spec
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath ((</>), takeDirectory)
import System.IO (hPutStrLn, stderr)
data Action =
SelectInterface String
| ListInterfaces
| ListCppFiles
| ListHsFiles
| GenCpp FilePath
| GenHaskell FilePath
| CleanCpp FilePath
| CleanHs FilePath
| KeepTempOutputsOnFailure
| DumpExtNames
| DumpEnums
| EnumEvalCachePath (Maybe FilePath)
| EnumEvalCacheMode EnumEvalCacheMode
data AppState = AppState
{ AppState -> Map String Interface
appInterfaces :: Map String Interface
, AppState -> String
appCurrentInterfaceName :: String
, AppState -> Caches
appCaches :: Caches
, AppState -> Bool
appKeepTempOutputsOnFailure :: Bool
, AppState -> Maybe String
appEnumEvalCachePath :: Maybe FilePath
, AppState -> EnumEvalCacheMode
appEnumEvalCacheMode :: EnumEvalCacheMode
}
data EnumEvalCacheMode =
RefreshEnumCache
| EnumCacheMustExist
appCurrentInterface :: AppState -> Interface
appCurrentInterface :: AppState -> Interface
appCurrentInterface AppState
state =
let name :: String
name = AppState -> String
appCurrentInterfaceName AppState
state
in case String -> Map String Interface -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name (Map String Interface -> Maybe Interface)
-> Map String Interface -> Maybe Interface
forall a b. (a -> b) -> a -> b
$ AppState -> Map String Interface
appInterfaces AppState
state of
Just Interface
iface -> Interface
iface
Maybe Interface
Nothing ->
String -> Interface
forall a. HasCallStack => String -> a
error (String -> Interface) -> String -> Interface
forall a b. (a -> b) -> a -> b
$
String
"Main.appCurrentInterface: Internal error, couldn't find current interface " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
initialAppState :: [Interface] -> AppState
initialAppState :: [Interface] -> AppState
initialAppState [Interface]
ifaces = AppState :: Map String Interface
-> String
-> Caches
-> Bool
-> Maybe String
-> EnumEvalCacheMode
-> AppState
AppState
{ appInterfaces :: Map String Interface
appInterfaces = [(String, Interface)] -> Map String Interface
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Interface)] -> Map String Interface)
-> [(String, Interface)] -> Map String Interface
forall a b. (a -> b) -> a -> b
$ (Interface -> (String, Interface))
-> [Interface] -> [(String, Interface)]
forall a b. (a -> b) -> [a] -> [b]
map (Interface -> String
interfaceName (Interface -> String)
-> (Interface -> Interface) -> Interface -> (String, Interface)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Interface -> Interface
forall a. a -> a
id) [Interface]
ifaces
, appCurrentInterfaceName :: String
appCurrentInterfaceName = Interface -> String
interfaceName (Interface -> String) -> Interface -> String
forall a b. (a -> b) -> a -> b
$ [Interface] -> Interface
forall a. [a] -> a
head [Interface]
ifaces
, appCaches :: Caches
appCaches = Caches
forall k a. Map k a
M.empty
, appKeepTempOutputsOnFailure :: Bool
appKeepTempOutputsOnFailure = Bool
False
, appEnumEvalCachePath :: Maybe String
appEnumEvalCachePath = Maybe String
forall a. Maybe a
Nothing
, appEnumEvalCacheMode :: EnumEvalCacheMode
appEnumEvalCacheMode = EnumEvalCacheMode
RefreshEnumCache
}
type Caches = Map String InterfaceCache
data InterfaceCache = InterfaceCache
{ InterfaceCache -> Maybe Generation
cacheGeneratedCpp :: Maybe Cpp.Generation
, InterfaceCache -> Maybe Generation
cacheGeneratedHaskell :: Maybe Haskell.Generation
, InterfaceCache -> Maybe ComputedInterfaceData
cacheComputedData :: Maybe ComputedInterfaceData
}
emptyCache :: InterfaceCache
emptyCache :: InterfaceCache
emptyCache = Maybe Generation
-> Maybe Generation
-> Maybe ComputedInterfaceData
-> InterfaceCache
InterfaceCache Maybe Generation
forall a. Maybe a
Nothing Maybe Generation
forall a. Maybe a
Nothing Maybe ComputedInterfaceData
forall a. Maybe a
Nothing
getGeneratedCpp ::
Maybe FilePath
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Cpp.Generation)
getGeneratedCpp :: Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedCpp Maybe String
maybeCppDir AppState
state Interface
iface InterfaceCache
cache = case InterfaceCache -> Maybe Generation
cacheGeneratedCpp InterfaceCache
cache of
Just Generation
gen -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache, Generation -> Either String Generation
forall a b. b -> Either a b
Right Generation
gen)
Maybe Generation
Nothing -> do
InterfaceCache
cache' <- Maybe String
-> AppState -> Interface -> InterfaceCache -> IO InterfaceCache
generateComputedData Maybe String
maybeCppDir AppState
state Interface
iface InterfaceCache
cache
ComputedInterfaceData
computedData <- (IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData)
-> Maybe ComputedInterfaceData
-> IO ComputedInterfaceData
-> IO ComputedInterfaceData
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (InterfaceCache -> Maybe ComputedInterfaceData
cacheComputedData InterfaceCache
cache') (IO ComputedInterfaceData -> IO ComputedInterfaceData)
-> IO ComputedInterfaceData -> IO ComputedInterfaceData
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"getGeneratedCpp: Expected computed data to already exist for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Interface -> String
forall a. Show a => a -> String
show Interface
iface String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
IO ComputedInterfaceData
forall a. IO a
exitFailure
case Interface -> ComputedInterfaceData -> Either String Generation
Cpp.generate Interface
iface ComputedInterfaceData
computedData of
l :: Either String Generation
l@(Left String
_) -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache', Either String Generation
l)
r :: Either String Generation
r@(Right Generation
gen) -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache' { cacheGeneratedCpp :: Maybe Generation
cacheGeneratedCpp = Generation -> Maybe Generation
forall a. a -> Maybe a
Just Generation
gen }, Either String Generation
r)
getGeneratedHaskell ::
AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Haskell.Generation)
getGeneratedHaskell :: AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedHaskell AppState
state Interface
iface InterfaceCache
cache = case InterfaceCache -> Maybe Generation
cacheGeneratedHaskell InterfaceCache
cache of
Just Generation
gen -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache, Generation -> Either String Generation
forall a b. b -> Either a b
Right Generation
gen)
Maybe Generation
Nothing -> do
InterfaceCache
cache' <- Maybe String
-> AppState -> Interface -> InterfaceCache -> IO InterfaceCache
generateComputedData Maybe String
forall a. Maybe a
Nothing AppState
state Interface
iface InterfaceCache
cache
ComputedInterfaceData
computedData <- (IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData)
-> Maybe ComputedInterfaceData
-> IO ComputedInterfaceData
-> IO ComputedInterfaceData
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (InterfaceCache -> Maybe ComputedInterfaceData
cacheComputedData InterfaceCache
cache') (IO ComputedInterfaceData -> IO ComputedInterfaceData)
-> IO ComputedInterfaceData -> IO ComputedInterfaceData
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"getGeneratedHaskell: Expected computed data to already exist for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Interface -> String
forall a. Show a => a -> String
show Interface
iface String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
IO ComputedInterfaceData
forall a. IO a
exitFailure
case Interface -> ComputedInterfaceData -> Either String Generation
Haskell.generate Interface
iface ComputedInterfaceData
computedData of
l :: Either String Generation
l@(Left String
_) -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache', Either String Generation
l)
r :: Either String Generation
r@(Right Generation
gen) -> (InterfaceCache, Either String Generation)
-> IO (InterfaceCache, Either String Generation)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache' { cacheGeneratedHaskell :: Maybe Generation
cacheGeneratedHaskell = Generation -> Maybe Generation
forall a. a -> Maybe a
Just Generation
gen }, Either String Generation
r)
generateComputedData ::
Maybe FilePath
-> AppState
-> Interface
-> InterfaceCache
-> IO InterfaceCache
generateComputedData :: Maybe String
-> AppState -> Interface -> InterfaceCache -> IO InterfaceCache
generateComputedData Maybe String
maybeCppDir AppState
state Interface
iface InterfaceCache
cache = case InterfaceCache -> Maybe ComputedInterfaceData
cacheComputedData InterfaceCache
cache of
Just ComputedInterfaceData
_ -> InterfaceCache -> IO InterfaceCache
forall (m :: * -> *) a. Monad m => a -> m a
return InterfaceCache
cache
Maybe ComputedInterfaceData
Nothing -> do
Map ExtName EvaluatedEnumData
evaluatedEnumMap <- AppState
-> Interface -> Maybe String -> IO (Map ExtName EvaluatedEnumData)
generateEnumData AppState
state Interface
iface Maybe String
maybeCppDir
InterfaceCache -> IO InterfaceCache
forall (m :: * -> *) a. Monad m => a -> m a
return InterfaceCache
cache
{ cacheComputedData :: Maybe ComputedInterfaceData
cacheComputedData = ComputedInterfaceData -> Maybe ComputedInterfaceData
forall a. a -> Maybe a
Just ComputedInterfaceData :: String -> Map ExtName EvaluatedEnumData -> ComputedInterfaceData
ComputedInterfaceData
{ computedInterfaceName :: String
computedInterfaceName = Interface -> String
interfaceName Interface
iface
, evaluatedEnumMap :: Map ExtName EvaluatedEnumData
evaluatedEnumMap = Map ExtName EvaluatedEnumData
evaluatedEnumMap
}
}
generateEnumData :: AppState -> Interface -> Maybe FilePath -> IO (Map ExtName EvaluatedEnumData)
generateEnumData :: AppState
-> Interface -> Maybe String -> IO (Map ExtName EvaluatedEnumData)
generateEnumData AppState
state Interface
iface Maybe String
maybeCppDir =
case AppState -> Maybe String
appEnumEvalCachePath AppState
state of
Maybe String
Nothing -> IO (Map ExtName EvaluatedEnumData)
doEnumEval
Just String
path -> do
Bool
cached <- String -> IO Bool
doesFileExist String
path
case (AppState -> EnumEvalCacheMode
appEnumEvalCacheMode AppState
state, Bool
cached) of
(EnumEvalCacheMode
RefreshEnumCache, Bool
_) -> String -> IO (Map ExtName EvaluatedEnumData)
evalAndWriteFile String
path
(EnumEvalCacheMode
EnumCacheMustExist, Bool
True) -> String -> IO (Map ExtName EvaluatedEnumData)
useFile String
path
(EnumEvalCacheMode
EnumCacheMustExist, Bool
False) -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"generateEnumData: Error, enum evaluation cache expected for " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Interface -> String
forall a. Show a => a -> String
show Interface
iface String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but none found at path '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."
IO (Map ExtName EvaluatedEnumData)
forall a. IO a
exitFailure
where useFile :: String -> IO (Map ExtName EvaluatedEnumData)
useFile String
path = String -> Map ExtName EvaluatedEnumData
deserializeEnumData (String -> Map ExtName EvaluatedEnumData)
-> IO String -> IO (Map ExtName EvaluatedEnumData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
path
evalAndWriteFile :: String -> IO (Map ExtName EvaluatedEnumData)
evalAndWriteFile String
path = do
Map ExtName EvaluatedEnumData
result <- IO (Map ExtName EvaluatedEnumData)
doEnumEval
String -> String -> IO ()
writeFileIfDifferent String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Map ExtName EvaluatedEnumData -> String
serializeEnumData Map ExtName EvaluatedEnumData
result
Map ExtName EvaluatedEnumData -> IO (Map ExtName EvaluatedEnumData)
forall (m :: * -> *) a. Monad m => a -> m a
return Map ExtName EvaluatedEnumData
result
doEnumEval :: IO (Map ExtName EvaluatedEnumData)
doEnumEval = do
Interface
-> Maybe String -> Bool -> IO (Map ExtName EvaluatedEnumData)
internalEvaluateEnumsForInterface Interface
iface Maybe String
maybeCppDir
(AppState -> Bool
appKeepTempOutputsOnFailure AppState
state)
serializeEnumData :: Map ExtName EvaluatedEnumData -> String
serializeEnumData :: Map ExtName EvaluatedEnumData -> String
serializeEnumData = Map String EvaluatedEnumData -> String
forall a. Show a => a -> String
show (Map String EvaluatedEnumData -> String)
-> (Map ExtName EvaluatedEnumData -> Map String EvaluatedEnumData)
-> Map ExtName EvaluatedEnumData
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtName -> String)
-> Map ExtName EvaluatedEnumData -> Map String EvaluatedEnumData
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys ExtName -> String
fromExtName
deserializeEnumData :: String -> Map ExtName EvaluatedEnumData
deserializeEnumData :: String -> Map ExtName EvaluatedEnumData
deserializeEnumData = (String -> ExtName)
-> Map String EvaluatedEnumData -> Map ExtName EvaluatedEnumData
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys HasCallStack => String -> ExtName
String -> ExtName
toExtName (Map String EvaluatedEnumData -> Map ExtName EvaluatedEnumData)
-> (String -> Map String EvaluatedEnumData)
-> String
-> Map ExtName EvaluatedEnumData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String EvaluatedEnumData
forall a. Read a => String -> a
read
defaultMain :: Either String Interface -> IO ()
defaultMain :: Either String Interface -> IO ()
defaultMain Either String Interface
interfaceResult = [Either String Interface] -> IO ()
defaultMain' [Either String Interface
interfaceResult]
defaultMain' :: [Either String Interface] -> IO ()
defaultMain' :: [Either String Interface] -> IO ()
defaultMain' [Either String Interface]
interfaceResults = do
[Interface]
interfaces <- [Either String Interface] -> IO [Interface]
ensureInterfaces [Either String Interface]
interfaceResults
[String]
args <- IO [String]
getArgs
[Action]
_ <- [Interface] -> [String] -> IO [Action]
run [Interface]
interfaces [String]
args
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ensureInterfaces :: [Either String Interface] -> IO [Interface]
ensureInterfaces :: [Either String Interface] -> IO [Interface]
ensureInterfaces [Either String Interface]
interfaceResults = [Either String Interface]
-> (Either String Interface -> IO Interface) -> IO [Interface]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either String Interface]
interfaceResults ((Either String Interface -> IO Interface) -> IO [Interface])
-> (Either String Interface -> IO Interface) -> IO [Interface]
forall a b. (a -> b) -> a -> b
$ \case
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error initializing interface: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO Interface
forall a. IO a
exitFailure
Right Interface
iface -> Interface -> IO Interface
forall (m :: * -> *) a. Monad m => a -> m a
return Interface
iface
run :: [Interface] -> [String] -> IO [Action]
run :: [Interface] -> [String] -> IO [Action]
run [Interface]
interfaces [String]
args = do
MVar AppState
stateVar <- AppState -> IO (MVar AppState)
forall a. a -> IO (MVar a)
newMVar (AppState -> IO (MVar AppState)) -> AppState -> IO (MVar AppState)
forall a b. (a -> b) -> a -> b
$ [Interface] -> AppState
initialAppState [Interface]
interfaces
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"This is a Hoppy interface generator. Use --help for options."
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Interfaces: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Interface -> String) -> [Interface] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Interface -> String
interfaceName [Interface]
interfaces)
IO ()
forall a. IO a
exitSuccess
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"--help" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar AppState -> IO ()
usage MVar AppState
stateVar IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
args
usage :: MVar AppState -> IO ()
usage :: MVar AppState -> IO ()
usage MVar AppState
stateVar = do
[String]
interfaceNames <- (Interface -> String) -> [Interface] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Interface -> String
interfaceName ([Interface] -> [String]) -> IO [Interface] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> IO [Interface]
getInterfaces MVar AppState
stateVar
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn
[ String
"Hoppy binding generator"
, String
""
, String
"Arguments: [ option... ] [ action... ]"
, String
" Arguments are processed in the order seen, so put options before the"
, String
" arguments they apply to. Normally, pass --gen-* last."
, String
""
, String
"Interfaces: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
interfaceNames
, String
""
, String
"Supported actions:"
, String
" --help Displays this menu."
, String
" --list-interfaces Lists the interfaces compiled into this binary."
, String
" --list-cpp-files Lists generated file paths in C++ bindings."
, String
" --list-hs-files Lists generated file paths in Haskell bindings."
, String
" --gen-cpp <outdir> Generate C++ bindings in a directory."
, String
" --gen-hs <outdir> Generate Haskell bindings under the given"
, String
" top-level source directory."
, String
" --clean-cpp <outdir> Removes generated file paths in C++ bindings."
, String
" --clean-hs <outdir> Removes generated file paths in Haskell bindings."
, String
" --dump-ext-names Lists the current interface's external names."
, String
" --dump-enums Lists the current interface's enum data."
, String
""
, String
"Supported options:"
, String
" --interface <iface> Sets the interface used for subsequent options."
, String
" --keep-temp-outputs-on-failure"
, String
" Keeps on disk any temporary programs that fail"
, String
" to build. Pass this before --gen-* commands."
, String
" --enum-eval-cache-path <path>"
, String
" --enum-eval-cache-mode <refresh|must-exist>"
, String
" Controls the behaviour of the enum evaluation result caching."
, String
" Caching is disabled if no path is given. With 'refresh', enums"
, String
" are always evaluated freshly and the cache file is updated."
, String
" With 'must-exist', the cache file must already exist."
]
processArgs :: MVar AppState -> [String] -> IO [Action]
processArgs :: MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
args =
case [String]
args of
[] -> [Action] -> IO [Action]
forall (m :: * -> *) a. Monad m => a -> m a
return []
String
"--interface":String
name:[String]
rest -> do
MVar AppState -> (AppState -> IO AppState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar AppState
stateVar ((AppState -> IO AppState) -> IO ())
-> (AppState -> IO AppState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
state ->
case String -> Map String Interface -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name (Map String Interface -> Maybe Interface)
-> Map String Interface -> Maybe Interface
forall a b. (a -> b) -> a -> b
$ AppState -> Map String Interface
appInterfaces AppState
state of
Maybe Interface
Nothing -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"--interface: Interface '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' doesn't exist in this generator."
Any
_ <- IO Any
forall a. IO a
exitFailure
AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
state
Just Interface
_ -> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
state { appCurrentInterfaceName :: String
appCurrentInterfaceName = String
name }
(String -> Action
SelectInterface String
nameAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--list-interfaces":[String]
rest -> do
MVar AppState -> IO ()
listInterfaces MVar AppState
stateVar
(Action
ListInterfacesAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--list-cpp-files":[String]
rest -> do
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation))
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedCpp Maybe String
forall a. Maybe a
Nothing
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--list-cpp-files: Failed to generate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO [Action]
forall a. IO a
exitFailure
Right Generation
gen -> do
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map String String -> [String]
forall k a. Map k a -> [k]
M.keys (Map String String -> [String]) -> Map String String -> [String]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Cpp.generatedFiles Generation
gen
(Action
ListCppFilesAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--list-hs-files":[String]
rest -> do
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedHaskell
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--list-hs-files: Failed to generate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO [Action]
forall a. IO a
exitFailure
Right Generation
gen -> do
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map String String -> [String]
forall k a. Map k a -> [k]
M.keys (Map String String -> [String]) -> Map String String -> [String]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Haskell.generatedFiles Generation
gen
(Action
ListHsFilesAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--gen-cpp":String
baseDir:[String]
rest -> do
Bool
baseDirExists <- String -> IO Bool
doesDirectoryExist String
baseDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
baseDirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"--gen-cpp: Please create this directory so that I can generate files in it: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
baseDir
IO ()
forall a. IO a
exitFailure
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation))
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedCpp (Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
baseDir
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--gen-cpp: Failed to generate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO [Action]
forall a. IO a
exitFailure
Right Generation
gen -> do
[(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String String -> [(String, String)])
-> Map String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Cpp.generatedFiles Generation
gen) (((String, String) -> IO ()) -> IO ())
-> ((String, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
(String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> IO ()) -> (String, String) -> IO ())
-> (String -> String -> IO ()) -> (String, String) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> IO ()
writeGeneratedFile String
baseDir
(String -> Action
GenCpp String
baseDirAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--gen-hs":String
baseDir:[String]
rest -> do
Bool
baseDirExists <- String -> IO Bool
doesDirectoryExist String
baseDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
baseDirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"--gen-hs: Please create this directory so that I can generate files in it: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
baseDir
IO ()
forall a. IO a
exitFailure
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedHaskell
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--gen-hs: Failed to generate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO [Action]
forall a. IO a
exitFailure
Right Generation
gen -> do
[(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String String -> [(String, String)])
-> Map String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Haskell.generatedFiles Generation
gen) (((String, String) -> IO ()) -> IO ())
-> ((String, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
subpath, String
contents) ->
String -> String -> String -> IO ()
writeGeneratedFile String
baseDir String
subpath String
contents
(String -> Action
GenHaskell String
baseDirAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--clean-cpp":String
baseDir:[String]
rest -> do
Bool
baseDirExists <- String -> IO Bool
doesDirectoryExist String
baseDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
baseDirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation))
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedCpp (Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> Maybe String
-> AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
baseDir
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--clean-cpp: Failed to evaluate interface: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO ()
forall a. IO a
exitFailure
Right Generation
gen -> do
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String String -> [String]
forall k a. Map k a -> [k]
M.keys (Map String String -> [String]) -> Map String String -> [String]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Cpp.generatedFiles Generation
gen) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
path ->
String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
baseDir String -> String -> String
</> String
path
(String -> Action
CleanCpp String
baseDirAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--clean-hs":String
baseDir:[String]
rest -> do
Bool
baseDirExists <- String -> IO Bool
doesDirectoryExist String
baseDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
baseDirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Either String Generation
genResult <- MVar AppState
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation))
-> (AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation))
-> IO (Either String Generation)
forall a b. (a -> b) -> a -> b
$ AppState
-> Interface
-> InterfaceCache
-> IO (InterfaceCache, Either String Generation)
getGeneratedHaskell
case Either String Generation
genResult of
Left String
errorMsg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--clean-hs: Failed to evaluate interface: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
IO ()
forall a. IO a
exitFailure
Right Generation
gen -> do
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String String -> [String]
forall k a. Map k a -> [k]
M.keys (Map String String -> [String]) -> Map String String -> [String]
forall a b. (a -> b) -> a -> b
$ Generation -> Map String String
Haskell.generatedFiles Generation
gen) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
path ->
String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
baseDir String -> String -> String
</> String
path
(String -> Action
CleanHs String
baseDirAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--dump-ext-names":[String]
rest -> do
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ()
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ())
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
_ Interface
iface InterfaceCache
cache -> do
Map String Module -> (Module -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Interface -> Map String Module
interfaceModules Interface
iface) ((Module -> IO ()) -> IO ()) -> (Module -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Module
m ->
Map ExtName Export -> (Export -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Module -> Map ExtName Export
moduleExports Module
m) ((Export -> IO ()) -> IO ()) -> (Export -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Export
export ->
[ExtName] -> (ExtName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Export -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getAllExtNames Export
export) ((ExtName -> IO ()) -> IO ()) -> (ExtName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ExtName
extName ->
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"extname module=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Module -> String
moduleName Module
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExtName -> String
fromExtName ExtName
extName
(InterfaceCache, ()) -> IO (InterfaceCache, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache, ())
(Action
DumpExtNamesAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--dump-enums":[String]
rest -> do
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ()
forall a.
MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar ((AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ())
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
state Interface
iface InterfaceCache
cache -> do
InterfaceCache
cache' <- Maybe String
-> AppState -> Interface -> InterfaceCache -> IO InterfaceCache
generateComputedData Maybe String
forall a. Maybe a
Nothing AppState
state Interface
iface InterfaceCache
cache
ComputedInterfaceData
computed <- (IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData)
-> Maybe ComputedInterfaceData
-> IO ComputedInterfaceData
-> IO ComputedInterfaceData
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ComputedInterfaceData
-> Maybe ComputedInterfaceData -> IO ComputedInterfaceData
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (InterfaceCache -> Maybe ComputedInterfaceData
cacheComputedData InterfaceCache
cache') (IO ComputedInterfaceData -> IO ComputedInterfaceData)
-> IO ComputedInterfaceData -> IO ComputedInterfaceData
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--dump-enums expected to have evaluated enum data, but doesn't."
IO ComputedInterfaceData
forall a. IO a
exitFailure
let allEvaluatedData :: Map ExtName EvaluatedEnumData
allEvaluatedData = ComputedInterfaceData -> Map ExtName EvaluatedEnumData
evaluatedEnumMap ComputedInterfaceData
computed
[(ExtName, EvaluatedEnumData)]
-> ((ExtName, EvaluatedEnumData) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ExtName EvaluatedEnumData -> [(ExtName, EvaluatedEnumData)]
forall k a. Map k a -> [(k, a)]
M.toList Map ExtName EvaluatedEnumData
allEvaluatedData) (((ExtName, EvaluatedEnumData) -> IO ()) -> IO ())
-> ((ExtName, EvaluatedEnumData) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ExtName
extName, EvaluatedEnumData
evaluatedData) -> do
Module
m <- (IO Module -> Maybe Module -> IO Module)
-> Maybe Module -> IO Module -> IO Module
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO Module -> Maybe Module -> IO Module
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (ExtName -> Map ExtName Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
extName (Map ExtName Module -> Maybe Module)
-> Map ExtName Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ Interface -> Map ExtName Module
interfaceNamesToModules Interface
iface) (IO Module -> IO Module) -> IO Module -> IO Module
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"--dump-enums couldn't find module for enum " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
IO Module
forall a. IO a
exitFailure
let typeStr :: String
typeStr =
Chunk -> String
Cpp.chunkContents (Chunk -> String) -> Chunk -> String
forall a b. (a -> b) -> a -> b
$ Writer [Chunk] () -> Chunk
forall a. Writer [Chunk] a -> Chunk
Cpp.execChunkWriter (Writer [Chunk] () -> Chunk) -> Writer [Chunk] () -> Chunk
forall a b. (a -> b) -> a -> b
$
Maybe [String] -> Type -> Writer [Chunk] ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [String] -> Type -> m ()
Cpp.sayType Maybe [String]
forall a. Maybe a
Nothing (Type -> Writer [Chunk] ()) -> Type -> Writer [Chunk] ()
forall a b. (a -> b) -> a -> b
$ NumericTypeInfo -> Type
numType (NumericTypeInfo -> Type) -> NumericTypeInfo -> Type
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType EvaluatedEnumData
evaluatedData
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"enum name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExtName -> String
fromExtName ExtName
extName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" module=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Module -> String
moduleName Module
m String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" type=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typeStr
[([String], Integer)] -> (([String], Integer) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map [String] Integer -> [([String], Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (Map [String] Integer -> [([String], Integer)])
-> Map [String] Integer -> [([String], Integer)]
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> Map [String] Integer
evaluatedEnumValueMap EvaluatedEnumData
evaluatedData) ((([String], Integer) -> IO ()) -> IO ())
-> (([String], Integer) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \([String]
words', Integer
number) ->
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"entry value=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
number String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
words'
(InterfaceCache, ()) -> IO (InterfaceCache, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceCache
cache', ())
(Action
DumpEnumsAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--keep-temp-outputs-on-failure":[String]
rest -> do
MVar AppState -> (AppState -> IO AppState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar AppState
stateVar ((AppState -> IO AppState) -> IO ())
-> (AppState -> IO AppState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
state -> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
state { appKeepTempOutputsOnFailure :: Bool
appKeepTempOutputsOnFailure = Bool
True }
(Action
KeepTempOutputsOnFailureAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--enum-eval-cache-path":String
path:[String]
rest -> do
let path' :: Maybe String
path' = if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
path
MVar AppState -> (AppState -> IO AppState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar AppState
stateVar ((AppState -> IO AppState) -> IO ())
-> (AppState -> IO AppState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
state -> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
state { appEnumEvalCachePath :: Maybe String
appEnumEvalCachePath = Maybe String
path' }
(Maybe String -> Action
EnumEvalCachePath Maybe String
path'Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
"--enum-eval-cache-mode":String
arg:[String]
rest -> do
EnumEvalCacheMode
mode <- case String
arg of
String
"must-exist" -> EnumEvalCacheMode -> IO EnumEvalCacheMode
forall (m :: * -> *) a. Monad m => a -> m a
return EnumEvalCacheMode
EnumCacheMustExist
String
"refresh" -> EnumEvalCacheMode -> IO EnumEvalCacheMode
forall (m :: * -> *) a. Monad m => a -> m a
return EnumEvalCacheMode
RefreshEnumCache
String
_ -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"--enum-eval-cache-mode received unexpected argument, got: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
IO EnumEvalCacheMode
forall a. IO a
exitFailure
MVar AppState -> (AppState -> IO AppState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar AppState
stateVar ((AppState -> IO AppState) -> IO ())
-> (AppState -> IO AppState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AppState
state -> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
state { appEnumEvalCacheMode :: EnumEvalCacheMode
appEnumEvalCacheMode = EnumEvalCacheMode
mode }
(EnumEvalCacheMode -> Action
EnumEvalCacheMode EnumEvalCacheMode
modeAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:) ([Action] -> [Action]) -> IO [Action] -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar AppState -> [String] -> IO [Action]
processArgs MVar AppState
stateVar [String]
rest
String
arg:[String]
_ -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid option, or missing argument for '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."
IO [Action]
forall a. IO a
exitFailure
writeGeneratedFile :: FilePath -> FilePath -> String -> IO ()
writeGeneratedFile :: String -> String -> String -> IO ()
writeGeneratedFile String
baseDir String
subpath String
contents = do
let path :: String
path = String
baseDir String -> String -> String
</> String
subpath
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
path
String -> String -> IO ()
writeFileIfDifferent String
path String
contents
withCurrentCache ::
MVar AppState
-> (AppState -> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache :: MVar AppState
-> (AppState
-> Interface -> InterfaceCache -> IO (InterfaceCache, a))
-> IO a
withCurrentCache MVar AppState
stateVar AppState -> Interface -> InterfaceCache -> IO (InterfaceCache, a)
fn = MVar AppState -> (AppState -> IO (AppState, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar AppState
stateVar ((AppState -> IO (AppState, a)) -> IO a)
-> (AppState -> IO (AppState, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \AppState
state -> do
let iface :: Interface
iface = AppState -> Interface
appCurrentInterface AppState
state
name :: String
name = Interface -> String
interfaceName Interface
iface
let cache :: InterfaceCache
cache = InterfaceCache -> Maybe InterfaceCache -> InterfaceCache
forall a. a -> Maybe a -> a
fromMaybe InterfaceCache
emptyCache (Maybe InterfaceCache -> InterfaceCache)
-> Maybe InterfaceCache -> InterfaceCache
forall a b. (a -> b) -> a -> b
$ String -> Caches -> Maybe InterfaceCache
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name (Caches -> Maybe InterfaceCache) -> Caches -> Maybe InterfaceCache
forall a b. (a -> b) -> a -> b
$ AppState -> Caches
appCaches AppState
state
(InterfaceCache
cache', a
result) <- AppState -> Interface -> InterfaceCache -> IO (InterfaceCache, a)
fn AppState
state Interface
iface InterfaceCache
cache
(AppState, a) -> IO (AppState, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( AppState
state { appCaches :: Caches
appCaches = String -> InterfaceCache -> Caches -> Caches
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
name InterfaceCache
cache' (Caches -> Caches) -> Caches -> Caches
forall a b. (a -> b) -> a -> b
$ AppState -> Caches
appCaches AppState
state }
, a
result
)
listInterfaces :: MVar AppState -> IO ()
listInterfaces :: MVar AppState -> IO ()
listInterfaces = (Interface -> IO ()) -> [Interface] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (Interface -> String) -> Interface -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> String
interfaceName) ([Interface] -> IO ())
-> (MVar AppState -> IO [Interface]) -> MVar AppState -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MVar AppState -> IO [Interface]
getInterfaces
getInterfaces :: MVar AppState -> IO [Interface]
getInterfaces :: MVar AppState -> IO [Interface]
getInterfaces = (AppState -> [Interface]) -> IO AppState -> IO [Interface]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String Interface -> [Interface]
forall k a. Map k a -> [a]
M.elems (Map String Interface -> [Interface])
-> (AppState -> Map String Interface) -> AppState -> [Interface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> Map String Interface
appInterfaces) (IO AppState -> IO [Interface])
-> (MVar AppState -> IO AppState)
-> MVar AppState
-> IO [Interface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar AppState -> IO AppState
forall a. MVar a -> IO a
readMVar