INblobs-0.1.1: src/INTextualUI.hs

module INTextualUI 
     ( genTextual
     , changeExt
     ) where

import Operations
import SafetyNet
import INTextual
import InfoKind
import State
import qualified PersistentDocument as PD

import Graphics.UI.WXCore hiding (Document)
import Graphics.UI.WX

import Data.Maybe

data What = Everything | JustRules | JustNet 

-- Generate textual description
genTextual :: (InfoKind n g, InfoKind e g) => IOOp g n e
genTextual doc state = 
  do mRes <- genTextualDialog state
     pDoc <- getDocument state
     inName <- PD.getFileName pDoc
     case mRes of 
       Nothing -> return ()
       Just (what, simp, wher, tool) -> 
         do let simpF = if simp then simplify else id
                filt = case what of
                         Everything -> id
                         JustRules  -> filterRules
                         JustNet    -> filterNet
                net = filt . simpF $ doc2net doc

            if wher 
              then -- save to file
                do w  <- getNetworkFrame state
                   safetyNet w $
                     do 
                        let filename = changeExt ".INblobs" ('-':show tool ++ ".net") $ fromMaybe "" inName
                        mf <- fileSaveDialog w 
                                rememberCurrentDir overwritePrompt 
                                "Save net equations"
                                [("Net Files", ["*.net"])] 
                                directory filename
                        case mf of
                          Nothing -> return ()
                          Just fn -> writeFile fn . showRepresentation tool $ net
  
              else -- print to screen
                do logMessage "printing Net"
                   logMessage (showRepresentation tool net)
                   putStr $ showRepresentation tool net
  where rememberCurrentDir = True
        overwritePrompt = True
        directory = "" 

-- | Change file extension and suffix filename.
changeExt :: String -- ^ \".INblobs\"
	-> String -- ^ \"-TOOL.net\"
	-> String -- ^ file.INblobs
	-> String -- ^ file-TOOL.net
changeExt old suffix = aux . span (/= '.')
  where
        aux (str,"") = str ++ suffix
        aux (str1, str2)
		| str2 == old = str1 ++ suffix
		| otherwise = let (str3,str4) = span (/='.') (tail str2)
                              in aux (str1 ++ '.':str3, str4)

genTextualDialog :: State g n e -> IO (Maybe (What, Bool, Bool, Representation))
genTextualDialog state =  
  do  theFrame <- getNetworkFrame state
      
      dialog <- dialog theFrame 
                    [ text := "Generate Textual Description"
--                    , visible := True
                    ]
      p  <- panel dialog []

      let infoWhat = [ ("interaction system and net", Everything)
                     , ("interaction system only", JustRules)
                     , ("interaction net only",JustNet)
                     ]
          (labelsWhat,dataWhat) = unzip infoWhat

      rWhat <- radioBox p Vertical labelsWhat  
                      [ text := "Of :"
                      , selection := 0 ]

      let infoSimp = [ ("simplified", True)
                     , ("not simplified", False)
                     ]
          (labelsSimp,dataSimp) = unzip infoSimp

      rSimp <- radioBox p Vertical labelsSimp   
                      [ text := "Version :"
                      , selection := 0 ]

      let infoWhere = [ ("save to file", True)
                      , ("print to screen", False)
                      ]
          (labelsWhere,dataWhere) = unzip infoWhere

      rWhere <- radioBox p Vertical labelsWhere   
                      [ text := "To :"
                      , selection := 0 ]
      let infoTool = [ ("AMIN", AMIN)
                     , ("PIN", PIN)
                     ]
          (labelsTool,dataTool) = unzip infoTool

      rTool <- radioBox p Vertical labelsTool   
                      [ text := "Output Tool :"
                      , selection := 0 ]

      ok <- button p [ text := "Ok" ]

      set dialog [ layout := container p $
                              margin 10 $ 
                               column 5 [ label "Generate textual description"
                                        , widget rWhat
                                        , widget rSimp 
                                        , widget rWhere
                                        , widget rTool
                                        , hfloatCentre $ widget ok 
                                        ]
                 ]

      showModal dialog $ \stop ->
                do set ok   [on command := 
                               do  iWhat  <- get rWhat selection
                                   iSimp  <- get rSimp selection
                                   iWhere <- get rWhere selection
                                   iTool  <- get rTool  selection

                                   stop (Just ( dataWhat  !! iWhat
                                              , dataSimp  !! iSimp
                                              , dataWhere !! iWhere
					      , dataTool  !! iTool
					      )
                                        ) ]