-- various methods for creating Llamas

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.LlamaWorks where


import           Relude

import           Potato.Flow.Owl
import Potato.Flow.OwlItem
import Potato.Flow.OwlState
import Potato.Flow.Llama
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types

import           Control.Exception (assert)

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)]