-- Simple Stupid Calculator demonstrating basic gtk/glade and parsec parser usage -- 
-- Hacked togeter by Miguel on May 3, 2018

{-# LANGUAGE PackageImports #-}
import "gtk3" Graphics.UI.Gtk
import Control.Monad.IO.Class
import Data.ByteString.Char8 (pack,unpack)
import Numeric
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Language
import Text.Parsec.Number (fractional2)
import Text.Parsec.Token

-- parse calculation -- 
calc s =  case parse expr "" s of Right x -> showFFloat Nothing x ""
                                  _       -> "?"

table = [ [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft ]
        , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] ]

lexer =  makeTokenParser haskellDef
expr  =  buildExpressionParser table term <?> "expression"
term  =  parens lexer expr <|> fractional2 False <?> "simple expression"

binary  name fun assoc = Infix (do{ reservedOp lexer name; return fun }) assoc

-- gui for the calculator --
main = do   initGUI
            builder <- builderNew
            builderAddFromFile builder "calc.glade"
            window <- builderGetObject builder castToWindow "mainWindow"
            output <- builderGetObject builder castToTextView "output"
            outputBuff <- textViewGetBuffer output
            hist <- builderGetObject builder castToTextView "hist"
            histBuff <- textViewGetBuffer hist
            end<-textBufferGetEndIter histBuff
            histMark <- textBufferCreateMark histBuff Nothing end True

            let conn  = connBtn    builder outputBuff
                connA = connBtnAct builder outputBuff

            -- connecting buttons --
            sequence_ $ conn <$> map show [0..9] ++ ["+","-","/","*","(",")","."]

            connA "CLR" $ textBufferSetByteString outputBuff (pack "")
            connA "DEL" $ manipTextBuff outputBuff (\x -> case x of [] -> []; xs -> init xs)
            connA "="   $ do txt<-getTextBuff outputBuff
                             manipTextBuff outputBuff calc
                             res<-getTextBuff outputBuff
                             manipTextBuff histBuff (\x -> x++txt++" = "++res++"\n")
                             end<-textBufferGetEndIter histBuff
                             textBufferMoveMark histBuff histMark end
                             textViewScrollToMark hist histMark 0 $ Just (0,1)
                             return ()

            -- handler to run on window destruction
            window `on` deleteEvent $ do liftIO mainQuit
                                         return False
            widgetShowAll window
            mainGUI

getTextBuff outputBuff = do start<-textBufferGetStartIter outputBuff
                            end<-textBufferGetEndIter outputBuff
                            unpack <$> textBufferGetByteString outputBuff start end True

manipTextBuff outputBuff action = do txt<-getTextBuff outputBuff
                                     textBufferSetByteString outputBuff (pack $ action $ txt)

connBtn builder buff label  = connBtnAct builder buff label $
                              textBufferInsertByteStringAtCursor buff (pack label)

connBtnAct builder buff label act = do btn <- builderGetObject builder castToButton label
                                       btn `on` buttonActivated $ act