--------------------------------------------------------------------------------
-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PresentationCommand -> PresentationCommand -> Bool
$c/= :: PresentationCommand -> PresentationCommand -> Bool
== :: PresentationCommand -> PresentationCommand -> Bool
$c== :: PresentationCommand -> PresentationCommand -> Bool
Eq, Int -> PresentationCommand -> ShowS
[PresentationCommand] -> ShowS
PresentationCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PresentationCommand] -> ShowS
$cshowList :: [PresentationCommand] -> ShowS
show :: PresentationCommand -> String
$cshow :: PresentationCommand -> String
showsPrec :: Int -> PresentationCommand -> ShowS
$cshowsPrec :: Int -> 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"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Exit
        String
"\n"                      -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\DEL"                    -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"h"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"j"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipForward
        String
"k"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipBackward
        String
"l"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        -- Arrow keys
        String
"\ESC[C"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\ESC[D"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"\ESC[B"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipForward
        String
"\ESC[A"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
SkipBackward
        -- PageUp and PageDown
        String
"\ESC[6"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Forward
        String
"\ESC[5"                  -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Backward
        String
"0"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
First
        String
"G"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Last
        String
"r"                       -> forall (m :: * -> *) a. Monad m => a -> m a
return PresentationCommand
Reload
        -- Number followed by enter
        String
_ | Just Int
n <- forall a. Read a => String -> Maybe a
readMaybe String
k -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PresentationCommand
Seek Int
n)
        String
_                         -> 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
                        forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c0, Char
c1, Char
c2]
                    Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c0, Char
c1]

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

            Char
_ -> 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 forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
readDigits else forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]


--------------------------------------------------------------------------------
data UpdatedPresentation
    = UpdatedPresentation !Presentation
    | ExitedPresentation
    | ErroredPresentation String
    deriving (Int -> UpdatedPresentation -> ShowS
[UpdatedPresentation] -> ShowS
UpdatedPresentation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatedPresentation] -> ShowS
$cshowList :: [UpdatedPresentation] -> ShowS
show :: UpdatedPresentation -> String
$cshow :: UpdatedPresentation -> String
showsPrec :: Int -> UpdatedPresentation -> ShowS
$cshowsPrec :: Int -> UpdatedPresentation -> ShowS
Show)


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

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

    clip :: Index -> Presentation -> Index
    clip :: Index -> Presentation -> Index
clip (Int
slide, Int
fragment) Presentation
pres
        | Int
slide    forall a. Ord a => a -> a -> Bool
>= Presentation -> Int
numSlides Presentation
pres = (Presentation -> Int
numSlides Presentation
pres forall a. Num a => a -> a -> a
- Int
1, Int
lastFragments forall a. Num a => a -> a -> a
- Int
1)
        | Int
slide    forall a. Ord a => a -> a -> Bool
<  Int
0              = (Int
0, Int
0)
        | Int
fragment forall a. Ord a => a -> a -> Bool
>= Int -> Int
numFragments' Int
slide =
            if Int
slide forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Presentation -> Int
numSlides Presentation
pres
                then (Int
slide, Int
lastFragments forall a. Num a => a -> a -> a
- Int
1)
                else (Int
slide forall a. Num a => a -> a -> a
+ Int
1, Int
0)
        | Int
fragment forall a. Ord a => a -> a -> Bool
< Int
0 =
            if Int
slide forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
>= Int
0
                then (Int
slide forall a. Num a => a -> a -> a
- Int
1, Int -> Int
numFragments' (Int
slide forall a. Num a => a -> a -> a
- Int
1) 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 = 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 forall a. Num a => a -> a -> a
- Int
1)

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

    reloadPresentation :: IO UpdatedPresentation
reloadPresentation = do
        Either String Presentation
errOrPres <- String -> IO (Either String Presentation)
readPresentation (Presentation -> String
pFilePath Presentation
presentation)
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ Presentation
pres
                { pActiveFragment :: Index
pActiveFragment = Index -> Presentation -> Index
clip (Presentation -> Index
pActiveFragment Presentation
presentation) Presentation
pres
                }