--------------------------------------------------------------------------------
-- | Module that allows the user to interact with the presentation
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
module Patat.Presentation.Interactive
    ( PresentationCommand (..)
    , readPresentationCommand

    , UpdatedPresentation (..)
    , updatePresentation
    ) where


--------------------------------------------------------------------------------
import           Data.Char                   (isDigit)
import           Patat.Presentation.Internal
import           Patat.Presentation.Read
import qualified System.IO                   as IO
import           Text.Read                   (readMaybe)


--------------------------------------------------------------------------------
data PresentationCommand
    = Exit
    | Forward
    | Backward
    | SkipForward
    | SkipBackward
    | First
    | Last
    | Reload
    | Seek Int
    | UnknownCommand String
    deriving (PresentationCommand -> PresentationCommand -> Bool
(PresentationCommand -> PresentationCommand -> Bool)
-> (PresentationCommand -> PresentationCommand -> Bool)
-> Eq PresentationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PresentationCommand -> PresentationCommand -> Bool
== :: PresentationCommand -> PresentationCommand -> Bool
$c/= :: PresentationCommand -> PresentationCommand -> Bool
/= :: PresentationCommand -> PresentationCommand -> Bool
Eq, Int -> PresentationCommand -> ShowS
[PresentationCommand] -> ShowS
PresentationCommand -> String
(Int -> PresentationCommand -> ShowS)
-> (PresentationCommand -> String)
-> ([PresentationCommand] -> ShowS)
-> Show PresentationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PresentationCommand -> ShowS
showsPrec :: Int -> PresentationCommand -> ShowS
$cshow :: PresentationCommand -> String
show :: PresentationCommand -> String
$cshowList :: [PresentationCommand] -> ShowS
showList :: [PresentationCommand] -> ShowS
Show)


--------------------------------------------------------------------------------
readPresentationCommand :: IO.Handle -> IO PresentationCommand
readPresentationCommand :: Handle -> IO PresentationCommand
readPresentationCommand Handle
h = do
    String
k <- IO String
readKeys
    case String
k of
        String
"q"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Exit
        String
"\n"                      -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\DEL"                    -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"h"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"j"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipForward
        String
"k"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipBackward
        String
"l"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        -- Arrow keys
        String
"\ESC[C"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\ESC[D"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"\ESC[B"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipForward
        String
"\ESC[A"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipBackward
        -- PageUp and PageDown
        String
"\ESC[6"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\ESC[5"                  -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"0"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
First
        String
"G"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Last
        String
"r"                       -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Reload
        -- Number followed by enter
        String
_ | Just Int
n <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
k -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PresentationCommand
Seek Int
n)
        String
_                         -> PresentationCommand -> IO PresentationCommand
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PresentationCommand
UnknownCommand String
k)
  where
    readKeys :: IO String
    readKeys :: IO String
readKeys = do
        Char
c0 <- Handle -> IO Char
IO.hGetChar Handle
h
        case Char
c0 of
            Char
'\ESC' -> do
                Char
c1 <- Handle -> IO Char
IO.hGetChar Handle
h
                case Char
c1 of
                    Char
'[' -> do
                        Char
c2 <- Handle -> IO Char
IO.hGetChar Handle
h
                        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c0, Char
c1, Char
c2]
                    Char
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c0, Char
c1]

            Char
_ | Char -> Bool
isDigit Char
c0 Bool -> Bool -> Bool
&& Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0' -> (Char
c0 Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
readDigits

            Char
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c0]

    readDigits :: IO String
    readDigits :: IO String
readDigits = do
        Char
c <- Handle -> IO Char
IO.hGetChar Handle
h
        if Char -> Bool
isDigit Char
c then (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
readDigits else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]


--------------------------------------------------------------------------------
data UpdatedPresentation
    = UpdatedPresentation !Presentation
    | ExitedPresentation
    | ErroredPresentation String


--------------------------------------------------------------------------------
updatePresentation
    :: PresentationCommand -> Presentation -> IO UpdatedPresentation

updatePresentation :: PresentationCommand -> Presentation -> IO UpdatedPresentation
updatePresentation PresentationCommand
cmd Presentation
presentation = case PresentationCommand
cmd of
    PresentationCommand
Exit             -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UpdatedPresentation
ExitedPresentation
    PresentationCommand
Forward          -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \(Int
s, Int
f) -> (Int
s, Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    PresentationCommand
Backward         -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \(Int
s, Int
f) -> (Int
s, Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    PresentationCommand
SkipForward      -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \(Int
s, Int
_) -> (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10, Int
0)
    PresentationCommand
SkipBackward     -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \(Int
s, Int
_) -> (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10, Int
0)
    PresentationCommand
First            -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \Index
_ -> (Int
0, Int
0)
    PresentationCommand
Last             -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \Index
_ -> (Presentation -> Int
numSlides Presentation
presentation, Int
0)
    Seek Int
n           -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ (Index -> Index) -> UpdatedPresentation
goToSlide ((Index -> Index) -> UpdatedPresentation)
-> (Index -> Index) -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ \Index
_ -> (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
0)
    PresentationCommand
Reload           -> IO UpdatedPresentation
reloadPresentation
    UnknownCommand String
_ -> UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Presentation -> UpdatedPresentation
UpdatedPresentation Presentation
presentation)
  where
    numSlides :: Presentation -> Int
    numSlides :: Presentation -> Int
numSlides Presentation
pres = Seq Slide -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Presentation -> Seq Slide
pSlides Presentation
pres)

    clip :: Index -> Presentation -> Index
    clip :: Index -> Presentation -> Index
clip (Int
slide, Int
fragment) Presentation
pres
        | Int
slide    Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Presentation -> Int
numSlides Presentation
pres = (Presentation -> Int
numSlides Presentation
pres Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
lastFragments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        | Int
slide    Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0              = (Int
0, Int
0)
        | Int
fragment Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
numFragments' Int
slide =
            if Int
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Presentation -> Int
numSlides Presentation
pres
                then (Int
slide, Int
lastFragments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                else (Int
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0)
        | Int
fragment Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
            if Int
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                then (Int
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int -> Int
numFragments' (Int
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                else (Int
slide, Int
0)
        | Bool
otherwise                  = (Int
slide, Int
fragment)
      where
        numFragments' :: Int -> Int
numFragments' Int
s = Int -> (Slide -> Int) -> Maybe Slide -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 Slide -> Int
numFragments (Int -> Presentation -> Maybe Slide
getSlide Int
s Presentation
pres)
        lastFragments :: Int
lastFragments   = Int -> Int
numFragments' (Presentation -> Int
numSlides Presentation
pres Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

    goToSlide :: (Index -> Index) -> UpdatedPresentation
    goToSlide :: (Index -> Index) -> UpdatedPresentation
goToSlide Index -> Index
f = Presentation -> UpdatedPresentation
UpdatedPresentation (Presentation -> UpdatedPresentation)
-> Presentation -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ Presentation
presentation
        { pActiveFragment = clip (f $ pActiveFragment presentation) presentation
        }

    reloadPresentation :: IO UpdatedPresentation
reloadPresentation = do
        Either String Presentation
errOrPres <- String -> IO (Either String Presentation)
readPresentation (Presentation -> String
pFilePath Presentation
presentation)
        UpdatedPresentation -> IO UpdatedPresentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdatedPresentation -> IO UpdatedPresentation)
-> UpdatedPresentation -> IO UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ case Either String Presentation
errOrPres of
            Left  String
err  -> String -> UpdatedPresentation
ErroredPresentation String
err
            Right Presentation
pres -> Presentation -> UpdatedPresentation
UpdatedPresentation (Presentation -> UpdatedPresentation)
-> Presentation -> UpdatedPresentation
forall a b. (a -> b) -> a -> b
$ Presentation
pres
                { pActiveFragment = clip (pActiveFragment presentation) pres
                }