GUIと計算部分の実装 (Haskell初心者が電卓アプリを作る : 2)

brew install gobject-introspection gtk+ gtk+3

dependencies:
- base >= 4.7 && < 5
- haskell-gi-base
- gi-gtk

import qualified GI.Gtk as Gtk

...

root_box <- new Gtk.Box [#orientation := Gtk.OrientationVertical]

text_view <- new Gtk.Entry [ #maxLength := 11, #editable := False]
keys_box <- new Gtk.Box [#orientation := Gtk.OrientationHorizontal]

#add root_box text_view
#add root_box keys_box

buffer <- Gtk.getEntryBuffer text_view
Gtk.setEntryBufferText buffer some_text

btn <- new Gtk.Button [ #label := "tmp" ]
_ <- on btn #clicked callback_func

_ <- after btn #clicked callback_func

data ExpNotation = ExpNotation {
    _exponent :: Maybe Int,
    _significand :: Int
}

data Operation = Plus | Sub | Prod | Div deriving (Show, Eq)

class (Num a, Fractional a) => CalcValue a where
    -- |
    -- 数字を末尾に追加する
    addDigit :: a -> Int -> a
    -- |
    -- 小数点をつける
    dot:: a -> a
    -- |
    -- 表示する
    display :: a -> String
    -- |
    -- 計算する
    calculate :: a -> a -> Maybe Operation -> a
    calculate _ _ Nothing = 0
    calculate dv1 dv2 (Just x)
        | x == Plus = dv1 + dv2
        | x == Sub = dv1 - dv2
        | x == Prod = dv1 * dv2
        | otherwise = dv1 / dv2

instance CalcValue ExpNotation where
    dot :: ExpNotation -> ExpNotation
    dot ExpNotation {_exponent = Nothing, _significand = x}
        = ExpNotation {_exponent = Just 0, _significand = x}
    dot dv = dv

    addDigit :: ExpNotation -> Int -> ExpNotation
    addDigit dv a
        | numOfDigits dv > limitOfDigits = dv
        | isNothing (_exponent dv)
            = dv {
                _significand = addDigitToLast (_significand dv) a
            }
        | isJust (_exponent dv) && a == 0 && _significand dv == 0
            = dv {
                _exponent = fmap (+1) (_exponent dv),
                _significand = 0
            }
        | otherwise =
            ExpNotation {
                _exponent = fmap (+1) (_exponent dv),
                _significand = addDigitToLast (_significand dv) a
            }
    display :: ExpNotation -> String
    display ExpNotation {
            _exponent = Nothing,
            _significand = x
        } = show x
    display ExpNotation {
            _exponent = Just e,
            _significand = x
        }
        | x == 0 =
            "0." ++ concat (replicate e "0")
        | otherwise =
            let
                sign_str = if x > 0 then "" else "-"
                abs_x = abs x
                digits = numOfDigits abs_x
            in
                if digits > e
                then
                    let
                        (int_part, deci_part) = splitAt (digits - e) $ show abs_x
                    in sign_str ++ int_part ++ "." ++ deci_part
                else
                    sign_str ++ "0." ++ concat (replicate (e - digits) "0") ++ show abs_x

ghci> :t (/)
(/) :: Fractional a => a -> a -> a

type MExpNotation = Maybe ExpNotation

instance Fractional MExpNotation where
    (/) :: MExpNotation -> MExpNotation -> MExpNotation
    Nothing / _ = Nothing
    _ / Nothing = Nothing
    _ / (Just 0) = Nothing
    (Just dv1) / (Just dv2) = Just (dv1 / dv2)

    fromRational :: Rational -> MExpNotation
    fromRational a = Just (fromRational a)

instance CalcValue MExpNotation where
    dot :: MExpNotation -> MExpNotation
    dot = fmap dot

    addDigit :: MExpNotation -> Int -> MExpNotation
    addDigit Nothing _ = Nothing
    addDigit (Just dv) a = Just (addDigit dv a)

    display :: MExpNotation -> String
    display Nothing = "Error"
    display (Just dv) = display dv

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, InstanceSigs #-}