module Potato.Flow.OwlHelpers where


import Relude

import Potato.Flow.Serialization.Snake
import Potato.Flow.Owl
import Potato.Flow.OwlItem
import Potato.Flow.Llama
import Potato.Flow.Methods.SEltMethods

superOwl_mustGetSLine :: SuperOwl -> SAutoLine
superOwl_mustGetSLine :: SuperOwl -> SAutoLine
superOwl_mustGetSLine SuperOwl
sowl = case OwlItem -> OwlSubItem
_owlItem_subItem(OwlItem -> OwlSubItem) -> OwlItem -> OwlSubItem
forall a b. (a -> b) -> a -> b
$ SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
  OwlSubItemLine SAutoLine
sline -> SAutoLine
sline
  OwlSubItem
x -> Text -> SAutoLine
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SAutoLine) -> Text -> SAutoLine
forall a b. (a -> b) -> a -> b
$ Text
"expected SAutoLine, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlSubItem -> Text
forall b a. (Show a, IsString b) => a -> b
show OwlSubItem
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" instead"

data SetLineStyleEnd = SetLineStyleEnd_Start | SetLineStyleEnd_End | SetLineStyleEnd_Both

setLineStyleEnd_setStart :: SetLineStyleEnd -> Bool
setLineStyleEnd_setStart :: SetLineStyleEnd -> Bool
setLineStyleEnd_setStart SetLineStyleEnd
SetLineStyleEnd_End = Bool
False
setLineStyleEnd_setStart SetLineStyleEnd
_ = Bool
True

setLineStyleEnd_setEnd :: SetLineStyleEnd -> Bool
setLineStyleEnd_setEnd :: SetLineStyleEnd -> Bool
setLineStyleEnd_setEnd SetLineStyleEnd
SetLineStyleEnd_Start = Bool
False
setLineStyleEnd_setEnd SetLineStyleEnd
_ = Bool
True


-- TODO move into Llama/Helpers.hs or something
makeLlamaForLineStyle :: SuperOwl -> SetLineStyleEnd -> LineStyle -> Llama
makeLlamaForLineStyle :: SuperOwl -> SetLineStyleEnd -> LineStyle -> Llama
makeLlamaForLineStyle SuperOwl
sowl SetLineStyleEnd
end LineStyle
newstyle = Llama
r where
  rid :: REltId
rid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl
  sline :: SAutoLine
sline = SuperOwl -> SAutoLine
superOwl_mustGetSLine SuperOwl
sowl
  newsline :: SAutoLine
newsline = SAutoLine
sline {
      _sAutoLine_lineStyle = if setLineStyleEnd_setStart end then newstyle else _sAutoLine_lineStyle sline
      , _sAutoLine_lineStyleEnd = if setLineStyleEnd_setEnd end then newstyle else _sAutoLine_lineStyleEnd sline
    }
  r :: Llama
r = (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)

makeLlamaForFlipLineStyle :: SuperOwl -> Maybe Llama
makeLlamaForFlipLineStyle :: SuperOwl -> Maybe Llama
makeLlamaForFlipLineStyle SuperOwl
sowl = Maybe Llama
r where
  seltl :: SEltLabel
seltl = SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack SuperOwl
sowl
  startStyle :: Maybe LineStyle
startStyle = SEltLabel -> Maybe LineStyle
getSEltLabelLineStyle SEltLabel
seltl
  endStyle :: Maybe LineStyle
endStyle = SEltLabel -> Maybe LineStyle
getSEltLabelLineStyleEnd SEltLabel
seltl
  rid :: REltId
rid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl
  sline :: SAutoLine
sline = SuperOwl -> SAutoLine
superOwl_mustGetSLine SuperOwl
sowl
  newsline :: SAutoLine
newsline = SAutoLine
sline {
      _sAutoLine_lineStyle = _sAutoLine_lineStyleEnd sline
      , _sAutoLine_lineStyleEnd = _sAutoLine_lineStyle sline
    }
  r :: Maybe Llama
r = if Maybe LineStyle
startStyle Maybe LineStyle -> Maybe LineStyle -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe LineStyle
endStyle
    then Maybe Llama
forall a. Maybe a
Nothing
    else Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)