{-|
Module : Main
Description : Boltzmann brain executable.
Copyright : (c) Maciej Bendkowski, 2018
License : BSD3
Maintainer : maciej.bendkowski@tcs.uj.edu.pl
Stability : experimental
-}
module Main
( main
) where
import System.IO
import System.Exit
import System.Console.GetOpt
import System.Environment
import Control.Monad (when)
import Data.Either (isLeft)
import Data.Maybe (fromMaybe)
import Data.List (nub)
import qualified Data.Map as M
import Data.Boltzmann.System
import Data.Boltzmann.System.Parser
import Data.Boltzmann.System.Errors
import Data.Boltzmann.System.Warnings
import Data.Boltzmann.Internal.Parser
import qualified Data.Boltzmann.System.Tuner as T
import Data.Boltzmann.Compiler
import qualified Data.Boltzmann.Compiler.Haskell.Algebraic as A
import qualified Data.Boltzmann.Compiler.Haskell.Rational as R
data Flag = OutputFile String
| InputPaganini String
| OutputPaganini
| Force
| Werror
| Version
| Help
deriving (Eq)
options :: [OptDescr Flag]
options = [Option "o" ["output"] (ReqArg OutputFile "FILE")
"Optional output file.",
Option "p" ["paganini-in"] (ReqArg InputPaganini "FILE")
"Paganini tuning vector for the given system.",
Option "s" ["paganini-out"] (NoArg OutputPaganini)
"Output a suitable Paganini specification for the given system.",
Option "f" ["force"] (NoArg Force)
"Whether to skip the well-foundedness check.",
Option "w" ["werror"] (NoArg Werror)
"Whether to treat warnings as errors.",
Option "v" ["version"] (NoArg Version)
"Prints the program version number.",
Option "h?" ["help"] (NoArg Help)
"Prints this help message."]
usageHeader :: String
usageHeader = "Usage: bb [OPTIONS...]"
versionHeader :: String
versionHeader = "Boltzmann Brain v1.3.1.3 (c) Maciej Bendkowski and Sergey Dovgal 2018"
compilerTimestamp :: String
compilerTimestamp = "Boltzmann Brain v1.3.1.3"
getPrecision :: System a -> Double
getPrecision sys =
case "precision" `M.lookup` annotations sys of
Just x -> read x :: Double
Nothing -> 1.0e-9
getMaxIter :: System a -> Maybe Int
getMaxIter sys =
case "maxiter" `M.lookup` annotations sys of
Just x -> return (read x :: Int)
Nothing -> Nothing
getModuleName :: System a -> String
getModuleName sys = fromMaybe "Sampler" ("module" `M.lookup` annotations sys)
output :: [Flag] -> Maybe String
output (OutputFile f : _) = Just f
output (_:fs) = output fs
output [] = Nothing
toPaganini :: [Flag] -> Bool
toPaganini flags = OutputPaganini `elem` flags
useForce :: [Flag] -> Bool
useForce flags = Force `elem` flags
fromPaganini :: [Flag] -> Maybe String
fromPaganini (InputPaganini s : _) = Just s
fromPaganini (_:fs) = fromPaganini fs
fromPaganini [] = Nothing
parse :: [String] -> IO ([Flag], [String])
parse argv = case getOpt Permute options argv of
(ops, nonops, [])
| Help `elem` ops -> do
putStr $ usageInfo usageHeader options
exitSuccess
| Version `elem` ops -> do
putStrLn versionHeader
exitSuccess
| otherwise -> return (nub (concatMap mkset ops), fs)
where
fs = if null nonops then [] else nonops
mkset x = [x]
(_, _, errs) -> do
hPutStr stderr (concat errs ++ usageInfo usageHeader options)
exitWith (ExitFailure 1)
run :: [Flag]
-> String
-> IO ()
run flags f = do
sys <- parseSystem f
case sys of
Left err -> printError err
Right sys' -> do
let ws = warnings sys'
reportSystemWarnings ws
case errors (useForce flags) sys' of
Left err' -> reportSystemError err'
Right sysT -> do
when (exitWerror flags ws) $ exitWith (ExitFailure 1)
if toPaganini flags then writeSpec sys' (output flags)
else runCompiler sys' sysT flags
exitWerror :: [Flag] -> WarningMonad () -> Bool
exitWerror flags ws = isLeft ws && Werror `elem` flags
writeSpec :: System Int -> Maybe FilePath -> IO ()
writeSpec sys' (Just f) = withFile f WriteMode (T.writeSpecification sys')
writeSpec sys' Nothing = T.writeSpecification sys' stdout
confCompiler :: PSystem Double -> Maybe String -> SystemType -> IO ()
confCompiler sys outputFile Rational = do
let conf = config sys outputFile
(getModuleName $ system sys)
compilerTimestamp :: R.Conf
R.compile conf
confCompiler sys outputFile Algebraic = do
let conf = config sys outputFile
(getModuleName $ system sys)
compilerTimestamp :: A.Conf
A.compile conf
confCompiler _ _ _ = error "I wasn't expecting the Spanish inquisition!"
runCompiler :: System Int -> SystemType -> [Flag] -> IO ()
runCompiler sys sysT flags =
case fromPaganini flags of
Nothing -> do
let arg = T.defaultArgs sys
pag <- T.runPaganini sys (Just $ arg { T.precision = getPrecision sys
, T.maxiters = fromMaybe (T.maxiters arg)
(getMaxIter sys) })
case pag of
Left err -> printError err
Right sys' -> confCompiler sys' (output flags) sysT
Just s -> do
pag <- T.readPaganini sys s
case pag of
Left err -> printError err
Right sys' -> confCompiler sys' (output flags) sysT
reportSystemError :: SystemError -> IO ()
reportSystemError err = do
hPrint stderr err
exitWith (ExitFailure 1)
reportSystemWarnings :: WarningMonad () -> IO ()
reportSystemWarnings (Left ws) = hPrint stderr ws
reportSystemWarnings _ = return ()
main :: IO ()
main = do
(ops, fs) <- getArgs >>= parse
case fs of
[] -> do hPutStr stderr (usageInfo usageHeader options)
exitWith (ExitFailure 1)
(f:_) -> do run ops f
exitSuccess