module Bayes.InterfaceWriter (networkInterface) where
import Data.Char
import Data.List
import Bayes.Network
import Bayes.Probability
import Bayes.SVG
networkInterface :: String -> Layout -> Network a -> String
networkInterface moduleName l nw = unlines $
[ moduleHeader moduleName
, networkDecl nw
, layoutDecl l
] ++ map (nodeDecl $ name nw) (nodes nw)
moduleHeader :: String -> String
moduleHeader moduleName = unlines
[ "-- generated code: do not change"
, "module Task.Network." ++ moduleName ++ " where"
, ""
, "import Bayes.Network"
, "import Bayes.SVG"
]
networkDecl :: Network a -> String
networkDecl nw = unlines
[ "network :: Network ()"
, "network = makeNetwork " ++ show (name nw) ++ " [" ++ xs ++ "]"
]
where
xs = commas (map f (nodes nw))
f = ("node_ " ++) . nodeToName (name nw) . nodeId
layoutDecl :: Layout -> String
layoutDecl l = unlines
[ "layout :: Layout"
, "layout = " ++ show l
]
nodeDecl :: String -> Node a -> String
nodeDecl nwName n@(Node i _ xs ps def) = unlines
[ nodeToName nwName i ++ " :: Node " ++ tp
, nodeToName nwName i ++ " = Node " ++ unwords args
]
where
args = [show i, show (label n), ppVals, show ps, "(" ++ showDefinition def ++ ")"]
(vals, tp) = valuesAndType xs
ppVals = "[" ++ commas (map ppVal vals) ++ "]"
ppVal (x, y) = "(" ++ y ++ ", " ++ x ++ ")"
nodeToName :: String -> String -> String
nodeToName nwName nodeName = (\(y:ys) -> toLower y:ys) $ case nwName `isPrefixOf` nodeName of
True -> drop (length nwName + 1) nodeName
False -> nodeName
showDefinition :: Definition -> String
showDefinition (CPT xs) = "CPT " ++ show (map toDouble xs)
showDefinition (NoisyMax str xs) = "NoisyMax " ++ show str ++ " " ++ show (map toDouble xs)
showDefinition (NoisyAdder str dubs xs) = "NoisyAdder " ++ show str ++ " " ++ show dubs ++ " " ++ show (map toDouble xs)
commas :: [String] -> String
commas = intercalate ","
valuesAndType :: [(String, a)] -> ([(String, String)], String)
valuesAndType list
| xs == ["Correct", "Incorrect"] = bool
| xs == ["Yes", "No"] = bool
| xs == ["Success", "Failure"] = bool
| xs == ["success", "failure"] = bool
| xs == ["Correct", "Incorrect", "Not_taken"] = maybool1
| xs == ["Incorrect", "Not_taken", "Correct"] = maybool2
| otherwise = (zip ss ss, "String")
where
xs = map fst list
ss = map show xs
bool = (zip ["True", "False"] ss, "Bool")
maybool1 = (zip ["Just True", "Just False", "Nothing"] ss, "(Maybe Bool)")
maybool2 = (zip ["Just False", "Nothing", "Just True"] ss, "(Maybe Bool)")