module Dialog.Internal where
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.IO.Class (MonadIO (..))
import Data.String (IsString (..))
import Control.Monad (ap)
import Data.Word (Word8)
data DialogT m a where
Pure :: a -> DialogT m a
Bind ::
(forall r. (forall b . DialogT m b -> (b -> DialogT m a) -> r) -> r) ->
DialogT m a
Lift :: m a -> DialogT m a
ChangeTitle :: String -> DialogT m ()
ChangeEndMessage :: String -> DialogT m ()
Display :: [Paragraph] -> DialogT m ()
AskLine :: String -> DialogT m String
instance Functor (DialogT m) where
fmap func (Pure val) = Pure (func val)
fmap func action = action >>= (\val -> pure (func val))
instance Applicative (DialogT m) where
pure = Pure
(<*>) = ap
instance Monad (DialogT m) where
actionA >>= makeActionB = Bind (\func -> func actionA makeActionB)
instance MonadTrans DialogT where
lift = Lift
instance MonadIO m => MonadIO (DialogT m) where
liftIO action = Lift (liftIO action)
type DialogIO = DialogT IO
changeTitle :: String -> DialogT m ()
changeTitle = ChangeTitle
changeEndMessage :: String -> DialogT m ()
changeEndMessage = ChangeEndMessage
displayLine :: String -> DialogT m ()
displayLine string = display [TextParagraph (Plain string)]
askLine :: String -> DialogT m String
askLine = AskLine
display :: [Paragraph] -> DialogT m ()
display = Display
data Paragraph =
TextParagraph FormattedText |
Picture PictureSource |
List ListStyle [ListItem] |
Table [TableRow]
deriving (Eq, Ord, Show)
data FormattedText =
Plain String |
Colored Color FormattedText |
Bold FormattedText |
Italic FormattedText |
Underline FormattedText |
Size FontSize FormattedText |
Link String FormattedText |
CompositeText [FormattedText]
deriving (Eq, Ord, Show)
instance IsString FormattedText where
fromString string = Plain string
(<+>) :: FormattedText -> FormattedText -> FormattedText
(<+>) (CompositeText a) (CompositeText b) =
CompositeText (a ++ b)
(<+>) a (CompositeText b) =
CompositeText (a:b)
(<+>) (CompositeText a) b =
CompositeText (a ++ [b])
(<+>) a b =
CompositeText [a, b]
infixr 6 <+>
data PictureSource
= PictureFromURL String
deriving (Eq, Ord, Show)
data ListStyle =
NumberedList |
BulletList
deriving (Eq, Ord, Show)
newtype ListItem =
ListItem [Paragraph]
deriving (Eq, Ord, Show)
newtype TableRow =
TableRow [TableCell]
deriving (Eq, Ord, Show)
data TableCell =
TableCell CellStyle [Paragraph]
deriving (Eq, Ord, Show)
data CellStyle =
NormalCell |
HeaderCell
deriving (Eq, Ord, Show)
data FontSize = FontSize Int
deriving (Eq, Ord)
instance Num FontSize where
(FontSize a) + (FontSize b) = mkFontSize (a + b)
(FontSize a) (FontSize b) = mkFontSize (a b)
(FontSize a) * (FontSize b) = mkFontSize (a * b)
negate = undefined "Can not negate a FontSize"
signum _ = FontSize 1
abs size = size
fromInteger integer = mkFontSize (fromInteger integer)
instance Show FontSize where
showsPrec prec (FontSize int) = showsPrec prec int
mkFontSize :: Int -> FontSize
mkFontSize int
| int < 0 =
error ("FontSize " ++ show int ++ " is negative")
| int == 0 =
error ("FontSize can not be zero")
| int < 25 =
error ("FontSize " ++ show int ++ " is too small (maximum is 25)")
| int > 1000 =
error ("FontSize " ++ show int ++ " is too large (maximum is 1000)")
| otherwise =
FontSize int
data Color = Color Word8 Word8 Word8
deriving (Eq, Ord, Show)
white :: Color
white = Color 255 255 255
black :: Color
black = Color 0 0 0
red :: Color
red = Color 255 0 0
green :: Color
green = Color 0 255 0
blue :: Color
blue = Color 0 0 255
rgb :: Word8 -> Word8 -> Word8 -> Color
rgb = Color
toRGB :: Color -> (Word8, Word8, Word8)
toRGB (Color r g b) = (r, g, b)