-- various methods for creating Llamas

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.LlamaWorks where


import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Owl
import Potato.Flow.OwlItem
import Potato.Flow.Attachments
import Potato.Flow.OwlWorkspace
import Potato.Flow.OwlState
import Potato.Flow.Llama
import           Potato.Flow.SElts
import           Potato.Flow.Types

import           Control.Exception (assert)

import qualified Data.Text         as T
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq



makeAddFolderLlama :: OwlPFState -> (OwlSpot, Text) -> Llama
makeAddFolderLlama :: OwlPFState -> (OwlSpot, Text) -> Llama
makeAddFolderLlama OwlPFState
pfs (OwlSpot
spot, Text
name) = OwlPFCmd -> Llama
makePFCLlama forall a b. (a -> b) -> a -> b
$ [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCNewElts [(OwlPFState -> REltId
owlPFState_nextId OwlPFState
pfs, OwlSpot
spot, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq REltId -> OwlSubItem
OwlSubItemFolder forall a. Seq a
Seq.empty))]

pfc_removeElt_to_deleteElts :: OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts :: OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts OwlPFState
pfs OwlParliament
owlp = forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlPFCmd
r where
  od :: OwlTree
od = OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs
  valid :: Bool
valid = OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid OwlTree
od forall a b. (a -> b) -> a -> b
$ OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
owlp
  sop :: SuperOwlParliament
sop = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
owlp
  sowlswithchildren :: Seq SuperOwl
sowlswithchildren = OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren OwlTree
od SuperOwlParliament
sop
  r :: OwlPFCmd
r = [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCDeleteElts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
..} -> (REltId
_superOwl_id, OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
od OwlItemMeta
_superOwl_meta, OwlItem
_superOwl_elt)) Seq SuperOwl
sowlswithchildren)

makeLlamaToSetAttachedLinesToCurrentPosition :: OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition :: OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition OwlPFState
pfs AttachmentMap
am REltId
target = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
target AttachmentMap
am of
    Maybe IntSet
Nothing       -> []
    Just IntSet
attached -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap REltId -> Llama
makeLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [REltId]
IS.toList forall a b. (a -> b) -> a -> b
$ IntSet
attached
  where
    makeLlama :: REltId -> Llama
    makeLlama :: REltId -> Llama
makeLlama REltId
rid = case SuperOwl -> OwlItem
_superOwl_elt (forall o. (HasOwlTree o, HasCallStack) => o -> REltId -> SuperOwl
hasOwlTree_mustFindSuperOwl OwlPFState
pfs REltId
rid) of
        OwlItem OwlInfo
_ (OwlSubItemLine SAutoLine
sline) -> Llama
r where
          startAttachment :: Maybe Attachment
startAttachment = SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline
          endAttachment :: Maybe Attachment
endAttachment = SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline
          affectstart :: Bool
affectstart = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target Maybe Attachment
startAttachment forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just REltId
target
          affectend :: Bool
affectend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target Maybe Attachment
endAttachment forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just REltId
target
          newstartpos :: XY
newstartpos = case HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
False OwlPFState
pfs Maybe Attachment
startAttachment of
            Maybe XY
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find attachment " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
startAttachment
            Just XY
x -> XY
x
          newendpos :: XY
newendpos = case HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
False OwlPFState
pfs Maybe Attachment
endAttachment of
            Maybe XY
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find attachment " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
endAttachment
            Just XY
x -> XY
x
          newsline :: SAutoLine
newsline = SAutoLine
sline {
              -- disconnect from target if it was deleted
              -- NOTE strictly speaking necessary! Not sure which way is better in multi-user mode
              _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = if Bool
affectstart then forall a. Maybe a
Nothing else SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline
              , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = if Bool
affectend  then forall a. Maybe a
Nothing else SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline

              -- place endpoints in new place
              , _sAutoLine_start :: XY
_sAutoLine_start = if Bool
affectstart then XY
newstartpos else SAutoLine -> XY
_sAutoLine_start SAutoLine
sline
              , _sAutoLine_end :: XY
_sAutoLine_end = if Bool
affectend then XY
newendpos else SAutoLine -> XY
_sAutoLine_end SAutoLine
sline

            }
          r :: Llama
r = (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)
        OwlItem
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"found non-line element in attachment list"

removeEltAndUpdateAttachments_to_llama :: OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama :: OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama OwlPFState
pfs AttachmentMap
am op :: OwlParliament
op@(OwlParliament Seq REltId
rids) = Llama
r where
  removellama :: Llama
removellama = OwlPFCmd -> Llama
makePFCLlama forall a b. (a -> b) -> a -> b
$  OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts OwlPFState
pfs OwlParliament
op
  resetattachllamas :: [Llama]
resetattachllamas = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition OwlPFState
pfs AttachmentMap
am) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REltId
rids)
  -- seems more correct to detach lines first and then delete the target so that undo operation is more sensible
  r :: Llama
r = [Llama] -> Llama
makeCompositionLlama forall a b. (a -> b) -> a -> b
$ [Llama]
resetattachllamas forall a. Semigroup a => a -> a -> a
<> [Llama
removellama]


-- TODO assert elts are valid
makeAddEltLlama :: OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama :: OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
pfs OwlSpot
spot OwlItem
oelt = OwlPFCmd -> Llama
makePFCLlama forall a b. (a -> b) -> a -> b
$ [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCNewElts [(OwlPFState -> REltId
owlPFState_nextId OwlPFState
pfs, OwlSpot
spot, OwlItem
oelt)]