{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Preview where

import           Relude

import Potato.Flow.Llama


data Shepard = Shepard Int deriving (Shepard -> Shepard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shepard -> Shepard -> Bool
$c/= :: Shepard -> Shepard -> Bool
== :: Shepard -> Shepard -> Bool
$c== :: Shepard -> Shepard -> Bool
Eq, Int -> Shepard -> ShowS
[Shepard] -> ShowS
Shepard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shepard] -> ShowS
$cshowList :: [Shepard] -> ShowS
show :: Shepard -> String
$cshow :: Shepard -> String
showsPrec :: Int -> Shepard -> ShowS
$cshowsPrec :: Int -> Shepard -> ShowS
Show, forall x. Rep Shepard x -> Shepard
forall x. Shepard -> Rep Shepard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Shepard x -> Shepard
$cfrom :: forall x. Shepard -> Rep Shepard x
Generic)

instance NFData Shepard

-- TODO use this to identify preview chains in the future
-- TODO also use to identify handlers
data Shift = Shift Int deriving (Shift -> Shift -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shift -> Shift -> Bool
$c/= :: Shift -> Shift -> Bool
== :: Shift -> Shift -> Bool
$c== :: Shift -> Shift -> Bool
Eq, Int -> Shift -> ShowS
[Shift] -> ShowS
Shift -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shift] -> ShowS
$cshowList :: [Shift] -> ShowS
show :: Shift -> String
$cshow :: Shift -> String
showsPrec :: Int -> Shift -> ShowS
$cshowsPrec :: Int -> Shift -> ShowS
Show, forall x. Rep Shift x -> Shift
forall x. Shift -> Rep Shift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Shift x -> Shift
$cfrom :: forall x. Shift -> Rep Shift x
Generic)

instance NFData Shift

dummyShepard :: Shepard
dummyShepard :: Shepard
dummyShepard = Int -> Shepard
Shepard Int
0

dummyShift :: Shift
dummyShift :: Shift
dummyShift = Int -> Shift
Shift Int
0


-- TODO add 
-- PO_StartAndCommit and PO_ContinueAndCommit are equivalent to doing a PO_Start or PO_Continue followed by a Preview_Commit, just for convenience
-- NOTE that PO_Start/PO_Continue will commit when another a preview comes in from the local user, the main reason you want to commit is to ensure the preview gets saved
-- NOTE that PO_CommitAndStart is identitacl to PO_Start but also asserts that there is a local preview
data PreviewOperation = 
  PO_Start 
  | PO_CommitAndStart 
  | PO_StartAndCommit 
  | PO_Continue 
  | PO_ContinueAndCommit 
  deriving (PreviewOperation -> PreviewOperation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreviewOperation -> PreviewOperation -> Bool
$c/= :: PreviewOperation -> PreviewOperation -> Bool
== :: PreviewOperation -> PreviewOperation -> Bool
$c== :: PreviewOperation -> PreviewOperation -> Bool
Eq, Int -> PreviewOperation -> ShowS
[PreviewOperation] -> ShowS
PreviewOperation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreviewOperation] -> ShowS
$cshowList :: [PreviewOperation] -> ShowS
show :: PreviewOperation -> String
$cshow :: PreviewOperation -> String
showsPrec :: Int -> PreviewOperation -> ShowS
$cshowsPrec :: Int -> PreviewOperation -> ShowS
Show, forall x. Rep PreviewOperation x -> PreviewOperation
forall x. PreviewOperation -> Rep PreviewOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreviewOperation x -> PreviewOperation
$cfrom :: forall x. PreviewOperation -> Rep PreviewOperation x
Generic)

data Preview = 
  -- apply a preview operation
  Preview PreviewOperation Llama 
  -- commit the last operation
  | Preview_Commit
  -- cancel the preview 
  | Preview_Cancel 
  deriving (Int -> Preview -> ShowS
[Preview] -> ShowS
Preview -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Preview] -> ShowS
$cshowList :: [Preview] -> ShowS
show :: Preview -> String
$cshow :: Preview -> String
showsPrec :: Int -> Preview -> ShowS
$cshowsPrec :: Int -> Preview -> ShowS
Show, forall x. Rep Preview x -> Preview
forall x. Preview -> Rep Preview x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Preview x -> Preview
$cfrom :: forall x. Preview -> Rep Preview x
Generic)

previewOperation_fromUndoFirst :: Bool -> PreviewOperation
previewOperation_fromUndoFirst :: Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
undoFirst = case Bool
undoFirst of
  Bool
True -> PreviewOperation
PO_Continue
  Bool
False -> PreviewOperation
PO_Start

previewOperation_toUndoFirst :: PreviewOperation -> Bool
previewOperation_toUndoFirst :: PreviewOperation -> Bool
previewOperation_toUndoFirst PreviewOperation
po = case PreviewOperation
po of
  PreviewOperation
PO_Start -> Bool
False
  PreviewOperation
PO_Continue -> Bool
True
  PreviewOperation
PO_StartAndCommit -> Bool
False
  PreviewOperation
PO_ContinueAndCommit -> Bool
True