module Potato.Flow.OwlItem where



import Relude

import Potato.Flow.Serialization.Snake
import Potato.Flow.DebugHelpers

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

instance NFData OwlInfo

data OwlSubItem =
  OwlSubItemNone
  | OwlSubItemFolder (Seq REltId)
  | OwlSubItemBox SBox
  | OwlSubItemLine SAutoLine
  | OwlSubItemTextArea STextArea
  deriving ((forall x. OwlSubItem -> Rep OwlSubItem x)
-> (forall x. Rep OwlSubItem x -> OwlSubItem) -> Generic OwlSubItem
forall x. Rep OwlSubItem x -> OwlSubItem
forall x. OwlSubItem -> Rep OwlSubItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OwlSubItem -> Rep OwlSubItem x
from :: forall x. OwlSubItem -> Rep OwlSubItem x
$cto :: forall x. Rep OwlSubItem x -> OwlSubItem
to :: forall x. Rep OwlSubItem x -> OwlSubItem
Generic, Int -> OwlSubItem -> ShowS
[OwlSubItem] -> ShowS
OwlSubItem -> String
(Int -> OwlSubItem -> ShowS)
-> (OwlSubItem -> String)
-> ([OwlSubItem] -> ShowS)
-> Show OwlSubItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlSubItem -> ShowS
showsPrec :: Int -> OwlSubItem -> ShowS
$cshow :: OwlSubItem -> String
show :: OwlSubItem -> String
$cshowList :: [OwlSubItem] -> ShowS
showList :: [OwlSubItem] -> ShowS
Show, OwlSubItem -> OwlSubItem -> Bool
(OwlSubItem -> OwlSubItem -> Bool)
-> (OwlSubItem -> OwlSubItem -> Bool) -> Eq OwlSubItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OwlSubItem -> OwlSubItem -> Bool
== :: OwlSubItem -> OwlSubItem -> Bool
$c/= :: OwlSubItem -> OwlSubItem -> Bool
/= :: OwlSubItem -> OwlSubItem -> Bool
Eq)

instance NFData OwlSubItem

owlSubItem_equivalent :: OwlSubItem -> OwlSubItem -> Bool
owlSubItem_equivalent :: OwlSubItem -> OwlSubItem -> Bool
owlSubItem_equivalent (OwlSubItemLine SAutoLine
slinea) (OwlSubItemLine SAutoLine
slineb) = SAutoLine
slinea SAutoLine -> SAutoLine -> Bool
forall a. Eq a => a -> a -> Bool
== SAutoLine
slineb
owlSubItem_equivalent OwlSubItem
a OwlSubItem
b = OwlSubItem
a OwlSubItem -> OwlSubItem -> Bool
forall a. Eq a => a -> a -> Bool
== OwlSubItem
b

data OwlItem = OwlItem {
  OwlItem -> OwlInfo
_owlItem_info :: OwlInfo
  , OwlItem -> OwlSubItem
_owlItem_subItem :: OwlSubItem
} deriving (Int -> OwlItem -> ShowS
[OwlItem] -> ShowS
OwlItem -> String
(Int -> OwlItem -> ShowS)
-> (OwlItem -> String) -> ([OwlItem] -> ShowS) -> Show OwlItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlItem -> ShowS
showsPrec :: Int -> OwlItem -> ShowS
$cshow :: OwlItem -> String
show :: OwlItem -> String
$cshowList :: [OwlItem] -> ShowS
showList :: [OwlItem] -> ShowS
Show, OwlItem -> OwlItem -> Bool
(OwlItem -> OwlItem -> Bool)
-> (OwlItem -> OwlItem -> Bool) -> Eq OwlItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OwlItem -> OwlItem -> Bool
== :: OwlItem -> OwlItem -> Bool
$c/= :: OwlItem -> OwlItem -> Bool
/= :: OwlItem -> OwlItem -> Bool
Eq, (forall x. OwlItem -> Rep OwlItem x)
-> (forall x. Rep OwlItem x -> OwlItem) -> Generic OwlItem
forall x. Rep OwlItem x -> OwlItem
forall x. OwlItem -> Rep OwlItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OwlItem -> Rep OwlItem x
from :: forall x. OwlItem -> Rep OwlItem x
$cto :: forall x. Rep OwlItem x -> OwlItem
to :: forall x. Rep OwlItem x -> OwlItem
Generic)

instance NFData OwlItem

instance PotatoShow OwlItem where
  potatoShow :: OwlItem -> Text
potatoShow = \case
    OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos) -> Text
"folder: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seq Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Seq Int
kiddos
    OwlItem OwlInfo
oinfo OwlSubItem
subitem -> Text
"elt: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case OwlSubItem
subitem of
        OwlSubItem
OwlSubItemNone -> Text
"none"
        OwlSubItemBox SBox
sbox -> SBox -> Text
forall b a. (Show a, IsString b) => a -> b
show SBox
sbox
        OwlSubItemLine SAutoLine
sline -> SAutoLine -> Text
forall b a. (Show a, IsString b) => a -> b
show SAutoLine
sline
        OwlSubItemTextArea STextArea
stextarea -> STextArea -> Text
forall b a. (Show a, IsString b) => a -> b
show STextArea
stextarea

class MommyOwl o where
  mommyOwl_kiddos :: o -> Maybe (Seq REltId)
  mommyOwl_hasKiddos :: o -> Bool
  mommyOwl_hasKiddos = Maybe (Seq Int) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Seq Int) -> Bool) -> (o -> Maybe (Seq Int)) -> o -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos

class HasOwlItem o where
  hasOwlItem_owlItem :: o -> OwlItem
  hasOwlItem_name :: o -> Text
  hasOwlItem_name = OwlItem -> Text
forall o. HasOwlItem o => o -> Text
hasOwlItem_name (OwlItem -> Text) -> (o -> OwlItem) -> o -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem
  hasOwlItem_isFolder :: o -> Bool
  hasOwlItem_isFolder = OwlItem -> Bool
forall o. HasOwlItem o => o -> Bool
hasOwlItem_isFolder (OwlItem -> Bool) -> (o -> OwlItem) -> o -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem
  hasOwlItem_attachments :: o -> [Attachment]
  hasOwlItem_attachments = OwlItem -> [Attachment]
forall o. HasOwlItem o => o -> [Attachment]
hasOwlItem_attachments (OwlItem -> [Attachment]) -> (o -> OwlItem) -> o -> [Attachment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem
  hasOwlItem_toSElt_hack :: o -> SElt
  hasOwlItem_toSElt_hack = OwlItem -> SElt
forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack (OwlItem -> SElt) -> (o -> OwlItem) -> o -> SElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem
  hasOwlItem_toSEltLabel_hack :: o -> SEltLabel
  hasOwlItem_toSEltLabel_hack = OwlItem -> SEltLabel
forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack (OwlItem -> SEltLabel) -> (o -> OwlItem) -> o -> SEltLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem
  hasOwlItem_toOwlSubItem :: o -> OwlSubItem
  hasOwlItem_toOwlSubItem = OwlItem -> OwlSubItem
_owlItem_subItem (OwlItem -> OwlSubItem) -> (o -> OwlItem) -> o -> OwlSubItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> OwlItem
forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem


owlItem_name :: OwlItem -> Text
owlItem_name :: OwlItem -> Text
owlItem_name = OwlInfo -> Text
_owlInfo_name (OwlInfo -> Text) -> (OwlItem -> OwlInfo) -> OwlItem -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlItem -> OwlInfo
_owlItem_info

owlItem_setName :: OwlItem -> Text -> OwlItem
owlItem_setName :: OwlItem -> Text -> OwlItem
owlItem_setName (OwlItem OwlInfo
oi OwlSubItem
x) Text
n = OwlInfo -> OwlSubItem -> OwlItem
OwlItem (OwlInfo
oi { _owlInfo_name = n}) OwlSubItem
x

instance MommyOwl OwlItem where
  mommyOwl_kiddos :: OwlItem -> Maybe (Seq Int)
mommyOwl_kiddos OwlItem
o = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
o of
    OwlSubItemFolder Seq Int
kiddos -> Seq Int -> Maybe (Seq Int)
forall a. a -> Maybe a
Just Seq Int
kiddos
    OwlSubItem
_ -> Maybe (Seq Int)
forall a. Maybe a
Nothing



owlSubItem_to_sElt_hack :: OwlSubItem -> SElt
owlSubItem_to_sElt_hack :: OwlSubItem -> SElt
owlSubItem_to_sElt_hack = \case
  OwlSubItemFolder Seq Int
_ -> SElt
SEltFolderStart
  OwlSubItemBox SBox
sbox -> SBox -> SElt
SEltBox SBox
sbox
  OwlSubItemLine SAutoLine
sline -> SAutoLine -> SElt
SEltLine SAutoLine
sline
  OwlSubItemTextArea STextArea
stextarea -> STextArea -> SElt
SEltTextArea STextArea
stextarea
  OwlSubItem
OwlSubItemNone -> SElt
SEltNone

instance HasOwlItem OwlItem where
  hasOwlItem_owlItem :: OwlItem -> OwlItem
hasOwlItem_owlItem = OwlItem -> OwlItem
forall a. a -> a
id
  hasOwlItem_name :: OwlItem -> Text
hasOwlItem_name = OwlItem -> Text
owlItem_name
  hasOwlItem_isFolder :: OwlItem -> Bool
hasOwlItem_isFolder OwlItem
o = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
o of
    OwlSubItemFolder Seq Int
_ -> Bool
True
    OwlSubItem
_ -> Bool
False
  hasOwlItem_attachments :: OwlItem -> [Attachment]
hasOwlItem_attachments OwlItem
o = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
o of
    OwlSubItemLine SAutoLine
sline -> [Maybe Attachment] -> [Attachment]
forall a. [Maybe a] -> [a]
catMaybes [SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline, SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline]
    OwlSubItem
_ -> []
  hasOwlItem_toSElt_hack :: OwlItem -> SElt
hasOwlItem_toSElt_hack = OwlSubItem -> SElt
owlSubItem_to_sElt_hack (OwlSubItem -> SElt) -> (OwlItem -> OwlSubItem) -> OwlItem -> SElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlItem -> OwlSubItem
_owlItem_subItem
  hasOwlItem_toSEltLabel_hack :: OwlItem -> SEltLabel
hasOwlItem_toSEltLabel_hack OwlItem
o = Text -> SElt -> SEltLabel
SEltLabel (OwlItem -> Text
forall o. HasOwlItem o => o -> Text
hasOwlItem_name OwlItem
o) (OwlItem -> SElt
forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack OwlItem
o)

-- DELETE use hasOwlItem variant instead
owlItem_toSElt_hack :: OwlItem -> SElt
owlItem_toSElt_hack :: OwlItem -> SElt
owlItem_toSElt_hack = OwlItem -> SElt
forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack

sElt_to_owlSubItem :: SElt -> OwlSubItem
sElt_to_owlSubItem :: SElt -> OwlSubItem
sElt_to_owlSubItem SElt
s = case SElt
s of
  SEltBox SBox
x -> SBox -> OwlSubItem
OwlSubItemBox SBox
x
  SEltLine SAutoLine
x -> SAutoLine -> OwlSubItem
OwlSubItemLine SAutoLine
x
  SEltTextArea STextArea
x -> STextArea -> OwlSubItem
OwlSubItemTextArea STextArea
x
  SElt
SEltNone -> OwlSubItem
OwlSubItemNone
  SElt
_ -> Text -> OwlSubItem
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> OwlSubItem) -> Text -> OwlSubItem
forall a b. (a -> b) -> a -> b
$ Text
"cannot convert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SElt -> Text
forall b a. (Show a, IsString b) => a -> b
show SElt
s