Add toml configuration support for probabilities

2 files changed, 59 insertions, 0 deletions

diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs
index 9bf3602..7e6a25e 100644
--- a/src/VeriFuzz.hs
+++ b/src/VeriFuzz.hs
@@ -15,6 +15,7 @@ module VeriFuzz
     , draw
     , SourceInfo(..)
     , module VeriFuzz.AST
+    , module VeriFuzz.Config
     , module VeriFuzz.ASTGen
     , module VeriFuzz.Circuit
     , module VeriFuzz.CodeGen
@@ -49,6 +50,7 @@ import           VeriFuzz.AST
 import           VeriFuzz.ASTGen
 import           VeriFuzz.Circuit
 import           VeriFuzz.CodeGen
+import           VeriFuzz.Config
 import           VeriFuzz.Env
 import           VeriFuzz.Gen
 import           VeriFuzz.Icarus
diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs
new file mode 100644
index 0000000..a51743e
--- /dev/null
+++ b/src/VeriFuzz/Config.hs
@@ -0,0 +1,57 @@
+{-|
+Module      : VeriFuzz.Config
+Description : Configuration file format and parser.
+Copyright   : (c) 2019, Yann Herklotz Grave
+License     : GPL-3
+Maintainer  : ymherklotz [at] gmail [dot] com
+Stability   : experimental
+Portability : POSIX
+
+Configuration file format and parser.
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module VeriFuzz.Config
+    ( Config(..)
+    , Probability(..)
+    , probAssign
+    , probAlways
+    , configProbability
+    , parseConfigFile
+    )
+where
+
+import           Control.Applicative (Alternative)
+import           Control.Lens        hiding ((.=))
+import           Data.Maybe          (fromMaybe)
+import           Toml                (TomlCodec, (.=))
+import qualified Toml
+
+data Probability = Probability { _probAssign :: {-# UNPACK #-} !Int
+                               , _probAlways :: {-# UNPACK #-} !Int
+                               }
+                 deriving (Eq, Show)
+
+makeLenses ''Probability
+
+newtype Config = Config { _configProbability :: Probability }
+               deriving (Eq, Show)
+
+makeLenses ''Config
+
+defaultValue
+  :: (Alternative r, Applicative w) =>
+     b -> Toml.Codec r w a b -> Toml.Codec r w a b
+defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional
+
+probCodec :: TomlCodec Probability
+probCodec = Probability
+    <$> Toml.int "assign" .= _probAssign
+    <*> defaultValue 1 (Toml.int "always") .= _probAlways
+
+configCodec :: TomlCodec Config
+configCodec = Toml.dimap _configProbability Config $ Toml.table probCodec "probability"
+
+parseConfigFile :: FilePath -> IO Config
+parseConfigFile = Toml.decodeFile configCodec