{-# LANGUAGE DeriveDataTypeable #-}

-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module UI.NCurses.Types where

import qualified Control.Applicative as A
import           Control.Exception (Exception, throwIO)
import           Control.Monad (liftM, ap)
import           Control.Monad.Fix (MonadFix, mfix)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.Trans.Reader (ReaderT)
import           Data.Typeable
import qualified Foreign as F
import qualified Foreign.C as F

import qualified UI.NCurses.Enums as E

-- | A small wrapper around 'IO', to ensure the @ncurses@ library is
-- initialized while running.
newtype Curses a = Curses { Curses a -> IO a
unCurses :: IO a }

instance Monad Curses where
	return :: a -> Curses a
return = IO a -> Curses a
forall a. IO a -> Curses a
Curses (IO a -> Curses a) -> (a -> IO a) -> a -> Curses a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
	m :: Curses a
m >>= :: Curses a -> (a -> Curses b) -> Curses b
>>= f :: a -> Curses b
f = IO b -> Curses b
forall a. IO a -> Curses a
Curses (Curses a -> IO a
forall a. Curses a -> IO a
unCurses Curses a
m IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Curses b -> IO b
forall a. Curses a -> IO a
unCurses (Curses b -> IO b) -> (a -> Curses b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Curses b
f)

instance MonadFix Curses where
	mfix :: (a -> Curses a) -> Curses a
mfix f :: a -> Curses a
f = IO a -> Curses a
forall a. IO a -> Curses a
Curses ((a -> IO a) -> IO a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Curses a -> IO a
forall a. Curses a -> IO a
unCurses (Curses a -> IO a) -> (a -> Curses a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Curses a
f))

instance MonadIO Curses where
	liftIO :: IO a -> Curses a
liftIO = IO a -> Curses a
forall a. IO a -> Curses a
Curses

instance Functor Curses where
	fmap :: (a -> b) -> Curses a -> Curses b
fmap = (a -> b) -> Curses a -> Curses b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance A.Applicative Curses where
	pure :: a -> Curses a
pure = a -> Curses a
forall (m :: * -> *) a. Monad m => a -> m a
return
	<*> :: Curses (a -> b) -> Curses a -> Curses b
(<*>) = Curses (a -> b) -> Curses a -> Curses b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

newtype Update a = Update { Update a -> ReaderT Window Curses a
unUpdate :: ReaderT Window Curses a }

instance Monad Update where
	return :: a -> Update a
return = ReaderT Window Curses a -> Update a
forall a. ReaderT Window Curses a -> Update a
Update (ReaderT Window Curses a -> Update a)
-> (a -> ReaderT Window Curses a) -> a -> Update a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT Window Curses a
forall (m :: * -> *) a. Monad m => a -> m a
return
	m :: Update a
m >>= :: Update a -> (a -> Update b) -> Update b
>>= f :: a -> Update b
f = ReaderT Window Curses b -> Update b
forall a. ReaderT Window Curses a -> Update a
Update (Update a -> ReaderT Window Curses a
forall a. Update a -> ReaderT Window Curses a
unUpdate Update a
m ReaderT Window Curses a
-> (a -> ReaderT Window Curses b) -> ReaderT Window Curses b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Update b -> ReaderT Window Curses b
forall a. Update a -> ReaderT Window Curses a
unUpdate (Update b -> ReaderT Window Curses b)
-> (a -> Update b) -> a -> ReaderT Window Curses b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Update b
f)

instance MonadFix Update where
	mfix :: (a -> Update a) -> Update a
mfix f :: a -> Update a
f = ReaderT Window Curses a -> Update a
forall a. ReaderT Window Curses a -> Update a
Update ((a -> ReaderT Window Curses a) -> ReaderT Window Curses a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Update a -> ReaderT Window Curses a
forall a. Update a -> ReaderT Window Curses a
unUpdate (Update a -> ReaderT Window Curses a)
-> (a -> Update a) -> a -> ReaderT Window Curses a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Update a
f))

instance Functor Update where
	fmap :: (a -> b) -> Update a -> Update b
fmap = (a -> b) -> Update a -> Update b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance A.Applicative Update where
	pure :: a -> Update a
pure = a -> Update a
forall (m :: * -> *) a. Monad m => a -> m a
return
	<*> :: Update (a -> b) -> Update a -> Update b
(<*>) = Update (a -> b) -> Update a -> Update b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

newtype Window = Window { Window -> Ptr Window
windowPtr :: F.Ptr Window }

newtype CursesException = CursesException String
	deriving (Int -> CursesException -> ShowS
[CursesException] -> ShowS
CursesException -> String
(Int -> CursesException -> ShowS)
-> (CursesException -> String)
-> ([CursesException] -> ShowS)
-> Show CursesException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursesException] -> ShowS
$cshowList :: [CursesException] -> ShowS
show :: CursesException -> String
$cshow :: CursesException -> String
showsPrec :: Int -> CursesException -> ShowS
$cshowsPrec :: Int -> CursesException -> ShowS
Show, Typeable)

instance Exception CursesException

checkRC :: String -> F.CInt -> IO ()
checkRC :: String -> CInt -> IO ()
checkRC name :: String
name rc :: CInt
rc = if CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
rc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== EnumWrapper -> Integer
forall a. Enum a => a -> Integer
E.fromEnum EnumWrapper
E.ERR
	then CursesException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> CursesException
CursesException (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": rc == ERR"))
	else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

cToBool :: Integral a => a -> Bool
cToBool :: a -> Bool
cToBool 0 = Bool
False
cToBool _ = Bool
True

cFromBool :: Integral a => Bool -> a
cFromBool :: Bool -> a
cFromBool False = 0
cFromBool True = 1