-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

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)")