/-  *boke, tp=trill-post, c=tlon-channels, ch=tlon-chat, cnt=contact, pols=polls
/+  dbug, js=json, plib=trill-utils, kaji, lib=boke, ui=trill-ui, mm=mmast, sr=sortug, const=constants, wall
/=  nav        /web/layout/nav
/=  router     /web/router
|%
++  page-size  10
+$  read-post
$:  title=@t
    =path
    contents=content-list:tp
    date=@da
    tags=(set @t)
    id=@ud
==
+$  read-comment
$:  author=@t
    date=@da
    contents=content-list:tp
    pa=@t
    parent=@da
    post=@da
    title=@t
==
+$  read-boardpost
$:  author=@t
    op=@t
    thread=@da
    date=@da
    title=@t
    content=content-list:tp
    id=@ud
    tid=@ud
==
+$  versioned-state
$%  state-0
==
+$  card  card:agent:gall
--
%-  agent:dbug
=|  state-0
=*  state  -
^-  agent:gall
=<
|_  =bowl:gall
+*  this      .
    hd   ~(. +> bowl)
    kaj  (init:kaji bowl _state kaji-req)
::
++  on-fail   |~(* `this)
++  on-leave  |~(* `this)
++  on-save   !>(state)
++  on-init  
^-  (quip card _this)
=.  state  init-state:hd
:_  this  init-cards:hd

++  on-load   |=  old=vase 
:_  this(state !<(versioned-state old))  ~
++  on-watch  
|=  =(pole knot)
~&  >>  on-watch=pole
  ?+  pole  !!
  [%ui ~]  `this
  [%http-response id=@ ~]    `this
  [%tv type=@t author=@t ~]  `this
  [%chat host=@t name=@t ~]  `this
  [%sse tab=@t ~]         `this 
  ==
++  on-poke
|=  [=mark =vase]
?:  (~(has in banned-ships:const) src.bowl)  `this  
|^
?+  mark  `this
%handle-http-request  serve
%noun  (on-poke-noun !<(* vase))
%kaji  run:handle-ui
==
  ++  handle-ui
  =/  fd  !<(form-data:kaji vase)
  =/  i  input.fd
  =/  tab-id  (~(got by input.fd) 'tab')
  =/  ui-card  ~(. ui:kaji tab-id)
  =/  origin     (~(got by input.fd) 'origin')
  |%
    ++  run
    ?+  action.fd  `this
    ::  polls
    %vote-poll
    =/  soption  (~(got by input.fd) 'option')
    =/  uoption  (dec:kaji soption ,[p=@p time=@da index=@ud])
    ?~  uoption  (send-error 'format error')
    =/  =pid:tp  [p.u.uoption time.u.uoption]
    =/  index    index.u.uoption
    =.  polls    (vote-poll:hd pid index)
    :_  this
    %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
    ::  radio
    %add-radio-chat
      =/  input  (~(got by input.fd) 'input')
      ?:  .=('' input)  (send-error 'no input')
      =/  stype  (~(got by input.fd) 'type')
      ?:  .=(stype 'urb')  
        =/  sowner  (~(got by input.fd) 'owner')
        =/  sip  (slaw %p sowner)
        ?~  sip  ~&  "error-parsing-radio-owner"  `this
        (radio-chat u.sip input)   
      ?:  .=(stype 'our')  
        =/  station  (~(got by input.fd) 'name')
        (bstv-chat station input)
      `this
          
    %change-radio
      =/  jon=json
      [%s 'lol']
      
      :_  this  :_  ~  
      %+  ui-fact:kaji  tab-id  :_  ~
      [%custom *manx jon]
    %add-chat  
      :_  this  :_  ~
      =/  input  (~(get by input.fd) 'input')
      ?~  input  (alert:ui-card "No input, please report to site@spandrell.ch or ~docteg-mothep")
      =/  parsed  (text-to-content:hd u.input)
      ?~  parsed  (alert:ui-card "Text parsing failed, please report to site@spandrel.ch or ~docteg-mothep")  
      (send-message:hd u.parsed)
    %add-thread
        =/  is-blog  ?=  ^  (~(get by input.fd) 'is-blog')
        =/  is-edit  ?=  ^  (~(get by input.fd) 'editing')
        =/  try-title  ?:  is-blog  validate-blog  validate-thread
        ?:  ?=(%err -.try-title)  (send-error +.try-title)
        =/  [title=@t tags=(set @t)]  +.try-title
        =/  try-post  (post-or-edit tags)
        ?:  ?=(%err -.try-post)  
          (send-error +.try-post)
          (go-save-thread title +.try-post is-blog is-edit)
      %add-reply
        =/  is-blog  ?=  ^  (~(get by input.fd) 'is-blog')
        =/  parents  (dec-i:kaji i 'parents' ,[pid:tp pid:tp])
        ?~  parents  (send-error 'parent cue error, please report to ~docteg-mothep or site@spandrell.ch')
        =/  try-post  (post-or-edit ~)
        ?:  ?=(%err -.try-post)  
          (send-error +.try-post)
          (go-save-reply +.try-post -.u.parents +.u.parents is-blog)

      %del-thread
        =/  is-blog  ?=  %~  (~(get by input.fd) 'is-blog')
        =/  pid  (dec-i:kaji input.fd 'pid' pid:tp)
        ?~  pid  (send-error 'no id to delete')
        =/  ted  (get:torm:tp threads u.pid)
        ?~  ted  (send-error 'thread-not-found')
        =.  feed     +:(del:gorm:tp feed u.pid)
        =.  threads  +:(del:torm:tp threads u.pid)
        =/  last-reply  ?~  replies.u.ted  u.pid  i.replies.u.ted
        =.  active-threads  
          +:(del:porm:tp active-threads last-reply)
        =.  feed  +:(del:gorm:tp feed u.pid)
        =.  paths  (~(del by paths) path.u.ted)
        =.  tags  (del-in-tags:hd tags.u.ted u.pid)
        :_  this
        ?:  is-blog
        %-  route:kaj  [route:router [%kaji tab-id %redi '/'] state]
        %-  route:kaj  [route:router [%kaji tab-id %redi '/board'] state]
    
      %del-reply
        =/  pid  (dec-i:kaji input.fd 'pid' pid:tp)
        ?~  pid  (send-error 'no id to delete')
        =/  p  (get:gorm:tp feed u.pid)
        ?~  p  (send-error 'post-not-found')
        ?~  parent.u.p  (send-error 'comment parent not set')
        =.  feed  +:(del:gorm:tp feed u.pid)
        =/  par  (get:gorm:tp feed u.parent.u.p)
        =.  feed  ?~  par  feed
          =/  nc  (~(del in children.u.par) u.pid)
          =/  np  u.par(children nc)
          (put:gorm:tp feed u.parent.u.p np)
        ::  branch whether it's the last reply or not as it affects the active-threads
        =/  ted  (get:torm:tp threads thread.u.p)
        ?~  ted  (send-error 'thread-not-found')
        =/  nr  %+  skip  replies.u.ted  |=  p=pid:tp  .=(u.pid p)
        ?~  replies.u.ted  (send-error 'weird')
        =/  last  i.replies.u.ted
        =/  is-last=?  .=(last u.pid)
        ?.  is-last
          =/  nted  u.ted(replies nr)
          =.  threads  (put:torm:tp threads thread.u.p nted)
          :_  this
          %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
        ::
          =/  nr  t.replies.u.ted
          =/  nted  u.ted(replies nr)
          =/  penultimo  ?~  nr  thread.u.p  i.nr
          =.  threads  (put:torm:tp threads thread.u.p nted)
          =.  active-threads  +:(del:porm:tp active-threads u.pid)
          =.  active-threads  (put:porm:tp active-threads penultimo thread.u.p)
          :_  this
          %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
    ==
      ++  validate-blog
        =/  stitle  (~(get by input.fd) 'title')
        ?~  stitle  :-  %err  'Please enter a title for the thread'
        ?:  .=('' u.stitle)  :-  %err  'Please enter a title for the thread'
        =/  stags  (~(get by input.fd) 'tags')
        ?~  stags  :-  %err  'No tags, please report to ~docteg-mothep or site@spandrell.ch'  
        =/  ntags  (parse-tags:ui u.stags)  
        ?~  ntags  :-  %err  'Error parsing tags, please report'
        =/  ttags  (~(put in u.ntags) 'blog')  
        =.  ttags  (~(del in ttags) '')
       [%ok u.stitle ttags]
      
      ++  validate-thread
        =/  stitle  (~(get by input.fd) 'title')
        ?~  stitle  :-  %err  'Please enter a title for the thread'
        ?:  .=('' u.stitle)  :-  %err  'Please enter a title for the thread'
        =/  sboard  (~(get by input.fd) 'board')
        ?~  sboard  :-  %err  'No board, please report'
        =/  stags  (~(get by input.fd) 'tags')
        ?~  stags  :-  %err  'No tags, please report to ~docteg-mothep or site@spandrell.ch'  
        =/  ntags  (parse-tags:ui u.stags)  
        ?~  ntags  :-  %err  'Error parsing tags, please report'
        =/  board  (~(get by categories:const) u.sboard)
        ?~  board  :-  %err  'No category, please report'
        =/  ttags  (~(put in u.ntags) u.sboard)  
        =.  ttags  (~(del in ttags) '')
       [%ok u.stitle ttags]

      ++  post-or-edit
      |=  ntags=(set @t)
        =/  stext      (~(get by input.fd) 'text')
        =/  upoll     find-poll
        =/  cl  (build-content stext upoll)
        ?:  ?=(%err -.cl)  cl
        =/  sedit   (~(get by input.fd) 'editing')
        ?~  sedit  :-  %ok  
          :: TODO title!
          (build-post:lib +.cl ntags [src.bowl now.bowl])

        =/  edit-pid  (dec:kaji u.sedit pid:tp)
        ?~  edit-pid  :-  %err  'Edit cue error, please report to ~docteg-mothep or site@spandrell.ch'
        =/  pedit  (get:gorm:tp feed u.edit-pid)
        ?~  pedit  :-  %err  'Post to edit not found, please report to ~docteg-mothep or site@spandrell.ch'
          :-  %ok  (edit-post:lib u.pedit +.cl ntags now.bowl)
        ::
        ++  build-content
          |=  [text=(unit @t) poll=(unit poll:pols)]  ^-  (maybe:sr content-list:tp)
            ?~  text
              ?~  poll  [%err 'no content!']
              ::  only poll
              =/  cl=content-list:tp  (insert-poll:hd ~ u.poll)  [%ok cl]
            ?:  .=(u.text '')  ?~  poll  [%err 'no content!']
              =/  cl=content-list:tp  (insert-poll:hd ~ u.poll)  [%ok cl]
              ::  have text
              =/  contents   (tokenize:ui u.text)
              ?~  contents   :-  %err  'Parsing error, please report to ~docteg-mothep or site@spandrell.ch'
              ?~  poll  [%ok contents]
                =/  cl=content-list:tp  
                (insert-poll:hd contents u.poll)  [%ok cl]
          
        ++  send-error
        |=  [text=@t]
          :_  this  :_  ~
          =/  =manx  ;span:"{(trip text)}"
          %+  ui-fact:kaji  tab-id

          =/  div  (~(get by input.fd) 'error-div')
          :_  ~  
          ?~  div
            [%alert manx 1.000]
            [%swap manx u.div .y]
        ::
        ++  go-save-thread
        |=  [title=@t p=post:tp is-blog=? is-edit=?]
          =/  s  (save-thread:hd title p is-blog is-edit)
          ?:  ?=(%err -.s)  (send-error +.s)
          =.  state  +.s
          =/  upoll  find-poll
          =.  polls  ?~  upoll  polls  (save-poll:hd u.upoll)
          :_  this  
          %-  route:kaj  [route:router [%kaji tab-id %board-redi p] state]
          ::  TODO notify mentions
          ::  would need an agent for remote hark tho
        ++  go-save-reply
        |=  [p=post:tp thread=pid:tp parent=pid:tp is-blog=?]
          =.  p  (set-parents:lib p thread parent)
          =/  s  (save-reply:hd p thread parent is-blog)
          ?:  ?=(%err -.s)  (send-error +.s)
          =.  state  +.s
          =/  upoll  find-poll
          =.  polls  ?~  upoll  polls  (save-poll:hd u.upoll)
          :_  this  
          ?:  is-blog
          %-  route:kaj  [route:router [%kaji tab-id %blog-redi p] state]
          %-  route:kaj  [route:router [%kaji tab-id %board-redi p] state]
        :: TODO  notify ships of their replies
        ::
        ++  bstv-chat
        |=  [name=@t input=@t]
          =/  tower  (~(get by here.tv) name)
          ?~  tower  `this
          =/  contents   (tokenize:ui input)
          =/  post  (build-post:lib contents ~ [src.bowl now.bowl])
          =/  station  (~(get by schedule.u.tower) started.current.u.tower)
          ?~  station  `this
          =.  chat.u.station  [post chat.u.station]
          =.  schedule.u.tower  (~(put by schedule.u.tower) started.current.u.tower u.station)
          =.  here.tv  (~(put by here.tv) name u.tower)
          :_  this
          %-  route:kaj  [route:router [%kaji tab-id %tv-chat name post] state]
        ++  radio-chat
        |=  [p=@p t=@t]
          =/  tower  (~(get by urbit.tv) p)
          ?~  tower  `this
          `this

        ::
        ++  find-poll  ^-  (unit poll:pols)
          :: =/  wal  ~(. wall src.bowl)
          :: ?~  (subscription-type:wal now.bowl)  ~
        =/  stitle  (~(get by input.fd) 'poll-title')
        ?~  stitle  ~
        ?:  .=('' u.stitle)  ~
        =/  opts=(list @t)  
          =|  acc=(list @t)  =|  i=@ud
          |-
            =/  key  %-  crip  "poll-opt-{(scow %ud i)}"
            =/  opt  (~(get by input.fd) key)
            ?~  opt  (flop acc) 
            =/  nacc  [u.opt acc]
            $(i +(i), acc nacc)
        ?~  opts  ~
        =/  smin-bet  (~(get by input.fd) 'poll-min-bet')
        ?~  smin-bet  ~
        :: =/  min-bet  ~
        :: TODO parse this
        =/  sexpiry  (~(get by input.fd) 'poll-expiry')
        :: ?~  sexpiry  ~
        =/  expiry   ?~  sexpiry  (add now.bowl ~d1)
          =/  parsed  (rush u.sexpiry html-datetime:parsing:sr)
          ?~  parsed  ~&  "some weird html fuckery"  (add now.bowl ~d1)
          u.parsed
          
        =/  multiple=?
          =/  smultiple  (~(get by input.fd) 'poll-multiple')
          ::  actually this doesn't get sent at all if unchecked?
          ?~  smultiple  .n  ?:  .=(u.smultiple 'on')  .y  .n  

        %-  some  %-  new-poll:pols  :*  [src.bowl now.bowl]  u.stitle  expiry  opts  multiple  ==
        
    --
  
    
    
  ::
  ++  on-poke-noun
  |=  a=*
  ?:  ?=([%data-dump *] a)     (sync-dump +.a)
  ?:  ?=(%gib a)     give-batdev
  ?>  .=(src.bowl our.bowl)
  :: ?:  ?=(%sync a)    poke-tasdev
  ?:  ?=(%tv-fix a)  tv-fix
  ?:  ?=(%backup a)  :_  this  :_  ~  dump-state:hd
  ?:  ?=(%restore a)  :-  ~  this(state restore:hd)
  ?:  ?=(%sync-last a)  :-  ~  this(state read-last:hd)
  ?:  ?=(%kaji a)  print-kaji
  ?:  ?=(%kick a)  kick-kaji
  ::  loading blog data
  ?:  ?=(%rblog a)    %-  wrap  load-blog:hd
  ?:  ?=(%rblog2 a)   %-  wrap  load-blog-comments:hd 
  ::  loading tianming data
  ?:  ?=(%rboard a)   %-  wrap  load-tianming
  ?:  ?=(%rboard2 a)  %-  wrap  load-tianming-replies
  :: ?:  ?=(%count a)  log
  ?:  ?=(%check a)  check
  ?:  ?=(%threads a)  check-threads
  ?:  ?=(%athreads a)  check-athreads
  ?:  ?=(%tags a)  check-tags
  ?:  ?=([%tag tag=@t] a)  (check-tag tag.a)
  :: ?:  ?=(%chcom a)  check-comment
  :: ?:  ?=(%sample a)  sample
  ?:  ?=(%pats a)  pats
  ?:  ?=(%feed a)  check-feed
  ?:  ?=(%radio a)  get-radio
  ?:  ?=(%tw a)       try-tw
  ?:  ?=([%check-thread *] a)  (check-thread +.a)
  ::  fixes
  ?:  ?=([%fix-thread *] a)  (fix-thread +.a)
  ?:  ?=([%dedup *] a)       (dedup +.a)
  ?:  ?=([%scrub-ded *] a)   (scrub +.a)
  ?:  ?=([%fix-active *] a)  (fix-active +.a)

  ?:  ?=(%sqlite a)  dump-to-sqlite
  ?:  ?=(%licki a)   init-lick
  ?:  ?=(%slick a)   stop-lick
  ?:  ?=([%lick *] a)  (send-lick +.a)
  `this
  ::
  ++  init-lick
    ~&  "init lick"
    :_  this  :_  ~
    =/  note=note-arvo  [%l %spin /'licker.sock']
    [%pass /lick/init %arvo note]
  ++  stop-lick
    :_  this  :_  ~
    =/  note=note-arvo  [%l %shut /'licker.sock']
    [%pass /lick/init %arvo note]
  ++  send-lick
  |=  a=*
    :_  this  :_  ~
    =/  note=note-arvo  [%l %spit /'licker.sock' %noun a]
    [%pass /lick/init %arvo note]

  :: ++  insert-sql
  :: """
  :: INSERT INTO posts(ts,author_id, title, content, snippet,  url)
  :: VALUES({tsn}, {author-idn}, {title}, {content}, {snippet}, {url});
  :: """
  :: ++  insert-sql2
  :: """
  :: INSERT INTO comments(ts,user_id, content, approved, comment_type, post_id, parent_id)
  :: VALUES({tsn}, {user-idn}, {content}, {approved-n}, {type}, {post-idn}, {parent-idn});
  :: """
  :: ++  insert-sql3
  :: """
  :: INSERT INTO tags(tag)
  :: VALUES({tsn}, {user-idn}, {content}, {approved-n}, {type}, {post-idn}, {parent-idn});
  :: """
  ++  dump-to-sqlite
    :: posts
    =/  count  0
    :: =/  l  (tap:gorm:tp feed)
    :: =/  res
    ::   |-
    ::   ?~  l  ~  
    ::   ?:  (gte count 20)  ~
    ::   =/  entry  i.l
    ::   =/  poast  val.entry
    ::   =/  is-blog  (~(has in tags.poast) 'blog')
    ::   ?:  is-blog
    ::     ~&  >>  poast=poast
    ::     =.  count  +(count)
    ::     $(l t.l)
    ::     $(l t.l)
    ::  threads
    =/  l  (tap:torm:tp threads)
    =/  res
      |-
      ?~  l  ~  
      ?:  (gte count 20)  ~
      =/  entry  i.l
      =/  ted  val.entry
      =/  is-blog  (~(has in tags.ted) 'blog')
      ?:  is-blog
        ~&  >>  ted=ted
        =.  count  +(count)
        $(l t.l)
        $(l t.l)
    :: TODO prov
    :: =/  tv-chat  
    ::   =/  tvs  (~(got by here.tv) 'spandrell-tv')
    ::   =/  sta  (~(got by schedule.tvs) started.current.tvs)
    ::   chat.sta 
    :: =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
    :: =/  vase  !>((jam data))
    :: =/  =soba:clay  :_  ~  [/data/site-dump/(scot %da now.bowl)/jam %ins %noun vase]
    :: =/  =nori:clay  [%& soba]
    :: =/  =task:clay  [%info %blog nori]
    :: init
    :: =/  note=note-arvo  [%l %spit /'licker.sock' %noun 'ligma']

    :: [%pass /lick/spit %arvo note]
    `this
  :: 
  ++  sync-dump
  |=  a=*
  ~&  dump-received=src.bowl
  ?>  .=(our.bowl ~batdev-docteg-mothep)
  =/  data=dump-type  (dump-type a)
  =.  feed     (gas:gorm:tp *gfeed:tp feed.data)
  =.  threads  (gas:torm:tp *threadsf threads.data)
  =.  active-threads  at.data
  =.  paths           paths.data
  =.  tags            tt.data
  `this
  ++  give-batdev
  ~&  sync-req-received=src.bowl
  ?>  .=(our.bowl ~tasdev-docteg-mothep)
  ?>  .=(src.bowl ~batdev-docteg-mothep)
  ~&  sync-req-received=src.bowl
  =/  tv-chat  
    =/  tvs  (~(got by here.tv) 'spandrell-tv')
    =/  sta  (~(got by schedule.tvs) started.current.tvs)
    chat.sta 
  ~&  "tv"
  =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
  :_  this  :_  ~  
  [%pass /gib %agent [~batdev-docteg-mothep %boke] %poke %noun !>([%data-dump data])]
  ++  poke-tasdev
  ~&  "poking tasdev"
  :_  this  :_  ~
  [%pass /gib %agent [~tasdev-docteg-mothep %boke] %poke %noun !>(%gib)]
  ++  tv-fix
  =/  muh  (~(got by here.tv) 'Spandrell TV')
  =.  here.tv  (~(del by here.tv) 'Spandrell TV')
  =.  here.tv  (~(put by here.tv) 'spandrell-tv' muh)
  `this
  ++  fix-thread  |=  a=*
  =/  =pid:tp  ;;  pid:tp  a
  =/  thread  (got:torm:tp threads pid)
  =/  post    (got:gorm:tp feed pid)
  =/  fn=full-node:tp  (node-to-full:plib post feed)
  =/  flat  (flatten-fn:plib fn)
  =/  pids  %+  turn  flat  |=  p=post:tp  [author.p id.p]
  =/  ordered  %+  sort  pids  |=  [a=pid:tp b=pid:tp]  (gth id.a id.b)
  =.  replies.thread  ordered
  =.  threads  (put:torm:tp threads pid thread)
  `this
  ++  fix-active  |=  a=*
  =/  =pid:tp  ;;  pid:tp  a
  =.  active-threads  +:(del:porm:tp active-threads pid)
  `this
  ++  check-thread  |=  a=*
  =/  =pid:tp  ;;  pid:tp  a
  =/  ted  (get:torm:tp threads pid)
  ~&  >>  ted=ted
  `this
  ++  scrub  |=  a=*
  =/  =pid:tp  ;;  pid:tp  a
  =/  ted  (got:torm:tp threads pid)
  ~&  >>  ted=ted
  =.  replies.ted  
    =/  l  replies.ted
    =|  nl=(list pid:tp)
    |-  
    ?~  l  (flop nl)
    =/  muh  i.l
    =/  pst  (get:gorm:tp feed muh)
    ?~  pst  $(l t.l)
    $(l t.l, nl [muh nl])
  =.  threads  (put:torm:tp threads pid ted)
  `this
  ++  dedup  |=  a=*
  =/  =pid:tp  ;;  pid:tp  a
  =/  ted  (got:torm:tp threads pid)
  ~&  >>  ted=ted
  =.  replies.ted  
    =/  l  replies.ted
    =|  nl=(list pid:tp)
    |-  
    ?~  l  (flop nl)
    =/  muh  i.l
    =/  pidset  (silt t.l)
    ?:  (~(has in pidset) muh)  $(l t.l)
    $(l t.l, nl [muh nl])
  ~&  new=replies.ted
  `this
++  try-tw
  :_  this  :_  ~
    [%pass /tw-test %arvo %k %fard q.byk.bowl %tw %noun !>([%user 'spandrell4'])]
  ++  get-radio
  :_  this  :_  ~  watch-radio-card:hd
  ++  print-kaji
  =/  a  %+  turn  ~(tap by sup.bowl)
  |=  [=duct [=ship =path]]
  ~&  >  duct
  ~&  >>>  ship
  ~&  >>  path
  duct
  `this
  ++  wrap
  |=  s=_state  =.  state  s  `this
  ++  kick-kaji
  :: =/  cards  %+  turn  ~(tap by sup.bowl)

  :: |=  [=duct [=ship =path]]
  :: ~&  >  duct
  :: ~&  >>>  ship
  :: ~&  >>  path
  =/  paths=(list path)  ~[/ui /sse/(scot %p our.bowl)]
  =/  cards  :_  ~  [%give %kick paths ~]
  ~&  kicking=cards
  [cards this]
  ++  check-feed
  ~&  %+  roll  (tap:gorm:tp feed)  |=  [[=pid:tp =post:tp] a=(list pid:tp)]
  ?.  (~(has in tags.post) 'blog')  a  [pid a]
  `this
  ++  pats
  ~&  >  paths
  `this
  ++  check-tags
  ~&  tags=tags
  `this
  ++  check-tag
  |=  t=@t
  :: ~&  (~(get by tags) t)
  =/  pids  (~(get by tags) t)
  ?~  pids  ~&  "not found"  `this
  =/  a  %+  turn  (tap:porm:tp u.pids)  |=  [=pid:tp p=pid:tp]
    =/  ted  (get:torm:tp threads pid)
    ?~  ted  ~&  ted-not-found=pid  ~
    ~&  >  thread=[title.u.ted]
    ~
  `this
  ++  check
  =/  last  (pry:gorm:tp feed)
  ~&  >  last=last
  `this
  ++  check-threads
    =/  t  %+  turn  (scag 10 (tap:torm:tp threads))  |=  [pid:tp thread:tp]
    ~&  >  thread=[title path (lent replies)]  ~
    `this
  ++  check-athreads
    =/  t  %+  turn  (scag 2 (tap:torm:tp threads))  |=  [pid:tp thread:tp]
    ~&  >  thread=[title (lent replies)]  ~
    `this
  ++  check-comment
  :: =/  last  (pry:orm:tp blog)
  :: ?~  last  `this
  :: ?~  parent.val.u.last  `this
  :: =/  parent  (get:orm:tp blog u.parent.val.u.last)
  :: ~&  >  last=last
  :: ~&  >>  parent=parent
  `this
  ++  sample
  :: ~&  >>  %+  scag  3  %+  skim  (tap:orm:tp blog)
  :: |=  [=id:tp =post:tp]  ?=(%~ parent.post)
  `this
  ++  log
    :: ~&  %-  lent  (tap:orm:tp blog)
    `this
  ++  load-tianming
    =/  j  .^(json %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/threads/json)
    =/  jjj  (boardpost:de:js j)
    |-
      ?~  jjj  state
      =/  a=read-boardpost  i.jjj
      =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
        (add (bex 64) author.a)
      =/  pid  [author date.a]
      =/  c  (put:corm:tp *content-map:tp date.a content.a)
      =|  p=post:tp
      =.  p  %=  p
      id  date.a
      author  -.pid
      thread  pid
      parent  ~
      contents  c
      tags  (silt `(list @t)`~['oldtianming'])
      ==
      =/  s  (save-thread:hd title.a p .n .n)
      =.  state  ?:  ?=(%err -.s)  state  +.s
      $(jjj t.jjj)
    
  ++  load-tianming-replies
    =/  j  .^(json %cx /(scot %p our.bowl)/boke/(scot %da now.bowl)/data/replies/json)
    =/  jjj  (boardpost:de:js j)
    |-
      ?~  jjj  state
      =/  a=read-boardpost  i.jjj
      =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
        (add (bex 64) author.a)
      =/  pid  [author date.a]
      =/  thread-author  ?:  .=((cass (trip op.a)) "spandrell")  ~docteg-mothep  
        (add (bex 64) op.a)
      =/  thread-pid  [thread-author thread.a]
      =/  c  (put:corm:tp *content-map:tp date.a content.a)
      =|  p=post:tp
      =.  p  %=  p
      id  date.a
      author  author
      thread  thread-pid
      parent  `thread-pid
      contents  c
      ==
      =.  state  
        =/  s  (save-reply:hd p thread-pid thread-pid .y)
        ?:  ?=(%err -.s)  state  +.s
      $(jjj t.jjj)
  ::
      
      :: =/  one  (put:gorm:tp feed pid p)
      :: =.  feed  ?~  parent-post  one
      :: =/  parent-pid  [author.u.parent-post parent.a]
      :: =/  full-parent  (get:gorm:tp feed parent-pid)
      :: ?~  full-parent  one
      ::   =/  oc  children.u.full-parent
      ::   =/  nc  (~(put in oc) pid)
      ::   =/  np  u.full-parent(children nc)
      ::   (put:gorm:tp one parent-pid np)
      :: =.  tags  =/  curr  (~(get by tags) 'blog-comment')
      ::   =/  nl  ?~  curr  ~[pid]  (snoc u.curr pid)
      ::   (~(put by tags) 'blog-comment' nl)
    :: =/  l  (tap:torm:tp threads)
    :: |-
    :: ?~  l  `this
    :: =/  t=thread:tp  +.i.l
    :: ?~  replies.t  $(l t.l)
    :: =/  del  (del:torm:tp active-threads -.i.l)
    :: =.  active-threads  ?~  -.del  threads
    :: (put:torm:tp +.del -.replies.t t)
    :: $(l t.l)


  ++  serve
  ^-  (quip card _this)
  =/  order  !<(eyre-order:kaji vase)
  =/  address  address.req.order
  ~&  >>  address=address
  ~&  >  req=url.request.req.order
  ?:  (~(has in banned-ips:const) address)  `this  
  :: ~&  >>>  malicious-request-alert=req.order  `this
  :_  this
  %-  route:kaj
  [route:router [%eyre order] state]
--
++  on-peek   
|=  =(pole knot)
?+  pole  ~
  [%x %manx %nav sip=@t ~]
    =/  sip  (slav %p sip.pole)
    =.  bowl  bowl(src sip)
    :-  ~  :-  ~  :-  %noun  !>
      =/  nv  nav(bowl bowl)  ext:nv
  [%x %chads sip=@t ~]
    :-  ~  :-  ~  :-  %noun  !>
    =/  sip  (slav %p sip.pole)
    =/  wal  ~(. wall sip)
    ?~  (subscription-type:wal now.bowl)  .n  .y
==
:: ~&  on-peek=pole
:: =/  blog  (~(got by feeds) %blog)
:: ?+  pole  ~
:: [%x %index ~]
::   =/  posts=(list full-node:tp)
::   %+  scag  page-size  
::   %-  flop
::   %+  roll  (tap:orm:tp blog)
::   |=  [i=[=id:tp =post:tp] a=(list full-node:tp)]
::   ?~  parent.post.i  [(node-to-full:plib post.i blog) a]  a
::   ``[%noun !>(posts)]
:: [%x %post rest=*]
::   ~&  >  rest=rest.pole
::   =/  p  (~(get by paths) rest.pole)
::   ?~  p  ~
::   =/  poast  (got:orm:tp blog id.u.p)
::   =/  fn  (node-to-full:plib poast blog)
::   ``[%noun !>(fn)]
:: :: [%x %search query=@ comments=@]
:: ::   =/  with-comments  .=(comments '1')
:: ::   ~
:: ==
++  on-agent
|=  [=wire =sign:agent:gall]
|^
  ?:  ?=(%kick -.sign)  resub
  ?:  ?=([%radio ~] wire)  handle-radio
  ?.  ?=(%fact -.sign)  `this
  ?:  ?=(%dm p.cage.sign)  (handle-dm !<(memo:c q.cage.sign))
  ?.  ?=(%channel-response p.cage.sign)  `this
  =/  res  !<(r-channels:c q.cage.sign)
  ?.  ?=(%post +<.res)  `this
  =/  =flag:tlonc  ->.res
  :_  this
  =/  r  r-post.r-channel.res
  ?-  -.r
  %set  ?~  post.r  ~  (route:kaj [route:router [%kaji '' %chat-msg flag +<.u.post.r] state])
  %reply  ~  :: reply-count.reply-meta.r  id-reply.r
  %reacts  ~  ::  reacts.r  ::  map
  %essay  ~  :: wtf
  ==
    ++  handle-dm
    |=  m=memo:c
    ::  validate TOTP and set cookie if so
    `this
    ++  handle-radio
      ?.  ?=(%fact -.sign)  `this
      =/  e  !<(radio-event q.cage.sign)
      ?.  ?=(%response -.e)  `this
      =.  urbit.tv  minitowers.e  `this
      
    ++  resub
    :_  this
    ?+  wire  ~
      [%radio ~]  :~(watch-radio-card:hd)
      [%chat %updates ~]  :~(watch-chat-card:hd)
    ==
    

--
++  on-arvo
  |=  [=(pole knot) =sign-arvo]
  |^
  ?:  ?=([%lick %soak *] sign-arvo)
    ?+  [mark noun]:sign-arvo  `this
    [%connect ~]  ((slog 'socket connected' ~) `this)
    [%disconnected ~]  ((slog 'socket disconnected' ~) `this)
    [%error *]  ((slog leaf+"socket error {(trip ;;(@t noun.sign-arvo))}" ~) `this)
    [%noun *]  ((slog leaf+"socket noun {(trip ;;(@t noun.sign-arvo))}" ~) `this)
  ==
  ::
  ?:  ?=([%arow *] +.sign-arvo)  (handle-thread +>.sign-arvo)
  ?.  ?=([%behn %wake *] sign-arvo)  `this
  ?.  ?=([%backup ~] pole)           `this
    :_  this  :_  ~  dump-state:hd
  ::
  ++  handle-thread
  |=  s=(avow:khan cage)
  ?:  ?=(%| -.s)  ~&  "thread failed"  `this
  =/  devase  !<(* +>.s)
  :: ?:  ?=(%& -.p.sign-arvo)  `this
  `this
  --
--
|_  =bowl:gall
::  saving to state
+$  save-res
$%  [%err err=@t]
    [%ok p=_state]
==
++  save-thread
|=  [title=@t p=post:tp is-blog=? is-edit=?]   ^-  save-res
  =/  post-pid  [author.p id.p]
  =.  feed   (put:gorm:tp feed post-pid p)
  =/  pat  ?:  is-blog  
    (make-blogpost-path:lib id.p title)
    (make-board-path:lib paths title tags.p)
  =/  t  ?.  is-edit  *thread:tp  (got:torm:tp threads post-pid)
  =/  snip-size  ?:  is-blog  500  200
  =/  snip  (abbreviate-post:plib contents.p snip-size)
  =.  t  t(title title, path pat, pid post-pid, tags tags.p, snip snip)  :: TODO remove titles from posts
  =.  threads   (put:torm:tp threads post-pid t)
  =.  active-threads   (put:porm:tp active-threads post-pid post-pid)
  =.  tags   (save-tags tags.p post-pid)  
  =.  paths   (~(put by paths) pat post-pid)
  :-  %ok  state
++  save-reply
|=  [p=post:tp thread=pid:tp parent=pid:tp blog=?]  ^-  save-res
  =.  p  (set-parents:lib p thread parent)
  =/  post-pid  [author.p id.p]
  =/  pop   (get:torm:tp threads thread)
  ?~  pop  [%err 'thread op not found please report to ~docteg-mothep or site@spandrell.ch']
  =/  ppar  (get:gorm:tp feed parent)
  ?~  ppar  [%err 'parent not found, please report to ~docteg-mothep or site@spandrell.ch']
  =.  feed   (put:gorm:tp feed post-pid p)
  =/  npar  u.ppar(children (~(put in children.u.ppar) post-pid))
  =.  feed  (put:gorm:tp feed parent npar)
  =/  has-reply  (~(has in (silt replies.u.pop)) post-pid)
  =/  nr  ?:  has-reply  replies.u.pop  [post-pid replies.u.pop]
  =/  npop     u.pop(replies nr)
  =.  threads  (put:torm:tp threads thread npop)
  =/  replies  replies.u.pop
  =/  last-reply  ?~  replies  thread  i.replies
  =/  delt  (del:porm:tp active-threads last-reply)
  =/  mmm  ?~  -.delt  ~&  >>>  thread-not-found-under-last-reply=post-pid  ~  ~
  =.  active-threads  +:delt
  =.  active-threads  (put:porm:tp active-threads post-pid thread)
  :-  %ok  state
::
++  save-tags
|=  [ntags=(set @t) =pid:tp]  ^-  tags-table
  =/  tag-list  ~(tap in ntags)
  |-  ^-  tags-table
  ?~  tag-list  tags
  =/  curr  (~(get by tags) i.tag-list)
  =/  npids  ?~  curr  
    (put:porm:tp *pidmap pid pid)
    (put:porm:tp u.curr pid pid)
  =/  nmap  (~(put by tags) i.tag-list npids)
  $(tag-list t.tag-list, tags nmap)

++  del-in-tags
|=  [ntags=(set @t) =pid:tp]  ^+  tags
  =/  tag-list  ~(tap in ntags)
  |-  ^+  tags
  ?~  tag-list  tags
  =/  curr  (~(get by tags) i.tag-list)
  =/  npids  ?~  curr  ~  +:(del:porm:tp u.curr pid)
  =/  nmap  (~(put by tags) i.tag-list npids)
  $(tag-list t.tag-list, tags nmap)

::  polls

++  save-poll
  |=  p=poll:pols  ^+  polls
    (~(put by polls) [author.p time.p] p)

++  insert-poll
  |=  [c=content-list:tp =poll:pols]  ^+  c
  =/  ref=block:tp  :-  %ref  :+  %polls  src.bowl  
    /(scot %p author.poll)/(scot %da time.poll)
    (snoc c ref)

++  vote-poll
  |=  [=pid:tp option=@ud]  
  =/  upoll  (~(get by polls) pid)
  ?~  upoll  polls  
  =/  =poll:pols  (add-vote u.upoll option)
  (~(put by polls) pid poll)
++  add-vote
  |=  [=poll:pols option=@ud]  ^+  poll
  ?:  ?=(%exc -.votes.poll)
    =.  p.votes.poll
      (~(put by p.votes.poll) src.bowl option)
      poll
    ::
    =.  p.votes.poll
      =/  curr  (~(get by p.votes.poll) option)
        =/  nmap=(map @p (set @ud))  
        ?~  curr
          %-  malt  ~[[src.bowl (silt ~[option])]]
          ::
          =/  my-votes=(unit (set @ud))  (~(get by u.curr) src.bowl)
          ?~  my-votes  
            (~(put by u.curr) src.bowl `(set @ud)`(silt ~[option]))
            (~(put by u.curr) src.bowl `(set @ud)`(~(put in u.my-votes) option))

        (~(put by p.votes.poll) option nmap)
        poll
        ::

::  
++  dump-state  ^-  card
  :: TODO prov
  =/  tv-chat  
    =/  tvs  (~(got by here.tv) 'spandrell-tv')
    =/  sta  (~(got by schedule.tvs) started.current.tvs)
    chat.sta 
  =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
  =/  vase  !>((jam data))
  =/  =soba:clay  :_  ~  [/data/site-dump/(scot %da now.bowl)/jam %ins %noun vase]
  =/  =nori:clay  [%& soba]
  =/  =task:clay  [%info %blog nori]
  =/  note=note-arvo  [%c task]
  [%pass /dump/[dap.bowl] %arvo note]
+$  dump-type
  $:  feed=(list feed-pair)
      threads=(list thread-pair)
      at=pidmap
      paths=pathmap
      tt=tags-table
      tv-chat=(list post:tp)
  ==

+$  feed-pair    [pid:tp post:tp]
+$  thread-pair  [pid:tp thread:tp]
++  read-last  ^+  state
  ~&  >  "restoring"
  =/  bp  /(scot %p our.bowl)/blog/(scot %da now.bowl)
  =/  f  .^((list path) %ct (weld bp /data/site-dump))  
  ?~  f  state
  =/  filename  (rear f)
  ~&  [f filename]
  =/  j  .^(@ %cx (weld bp filename))
  ~&  read-file=(end [0 100] j)
  =/  cued  (cue j)
  =/  data  ;;(dump-type cued)
  ~&  >>>  lengths=[(lent feed.data) (lent threads.data)] 
  =/  tvs  (~(got by here.tv) 'spandrell-tv')
  =/  sta  (~(got by schedule.tvs) started.current.tvs)
  =.  chat.sta  tv-chat.data
  =.  schedule.tvs  (~(put by schedule.tvs) started.current.tvs sta)
  =.  here.tv  (~(put by here.tv) 'spandrell-tv' tvs)
  %=  state
    feed  (gas:gorm:tp *gfeed:tp feed.data)
    threads  (gas:torm:tp *threadsf threads.data)
    active-threads  at.data
    paths  paths.data
    tags  tt.data
  ==
++  restore  ^+  state
  ~&  >  "restoring"
  =/  j  .^(@ %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/site-dump/jam)
  ~&  read-file=(end [0 100] j)
  =/  cued  (cue j)
  =/  data  ;;(dump-type cued)
  ~&  >>>  lengths=[(lent feed.data) (lent threads.data)] 
  =/  tvs  (~(got by here.tv) 'spandrell-tv')
  =/  sta  (~(got by schedule.tvs) started.current.tvs)
  =.  chat.sta  tv-chat.data
  =.  schedule.tvs  (~(put by schedule.tvs) started.current.tvs sta)
  =.  here.tv  (~(put by here.tv) 'spandrell-tv' tvs)
  %=  state
    feed  (gas:gorm:tp *gfeed:tp feed.data)
    threads  (gas:torm:tp *threadsf threads.data)
    active-threads  at.data
    paths  paths.data
    tags  tt.data
  ==
:: Cards
++  watch-radio-card  ^-  card
[%pass /radio %agent [~docteg-mothep %tower] %watch /towers]
++  watch-chat-card  ^-  card
[%pass /chat/updates %agent [our.bowl %channels] %watch /chat/(scot %p our.bowl)/chat]
++  watch-dms-card  ^-  card
[%pass /dm-root %agent [our.bowl %chat] %watch /]
++  watch-cards  ^-  (list card)
:~  watch-radio-card
    watch-chat-card
==
++  root-path-card  ^-  card
  [%pass /mmm %arvo %e %connect [~ /] dap.bowl]
++  init-cards  ^-  (list card)
:~  watch-radio-card
    watch-chat-card
    watch-dms-card
    root-path-card
    schedule-backup-card
==
++  schedule-backup-card  ^-  card
  [%pass /backup %arvo %b %wait (add now.bowl ~h6)]

++  init-state  ^+  state
=.  tv  init-tv
:: =.  state  load-blog
:: =.  state  load-blog-comments
state
++  init-tv  ^+  tv
=/  starting=@da  now.bowl
=/  sta=tv-station  :*
  'Dune Month!'
  'https://hydrogen.finnem.net/hls/live.m3u8'
  starting
  ~
  ~
  chat-welcome-post^~
  ~
==
=/  schedule  %-  malt  :_  ~  [starting sta]
=/  =bstv  ['Spandrell TV' ~docteg-mothep ['Dune Month!' starting] schedule]
=.  here.tv  (~(put by here.tv) 'spandrell-tv' bstv)
tv

++  chat-welcome-post  ^-  post:tp
=/  contents   (tokenize:ui 'Welcome to Spandrell TV! Make yourself cozy')
(build-post:lib contents ~ [~docteg-mothep now.bowl])
++  load-blog
  =/  j  .^(json %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/posts/json)
  =/  jjj  (poast:de:js j)
  |-
    ?~  jjj  state
    =/  a=read-post  i.jjj
    =/  pid  [~docteg-mothep date.a]
    =/  c  (put:corm:tp *content-map:tp date.a contents.a)
    =/  tgs  (~(put in tags.a) 'blog')
    =|  p=post:tp
    =.  p  %=  p
    id  date.a
    author  -.pid
    thread  pid
    contents  c
    tags  tgs
    ==
    =/  s  (save-thread title.a p .y .n)
    =.  state  ?:  ?=(%err -.s)  state  +.s
    $(jjj t.jjj)

++  load-blog-comments
  =/  j  .^(json %cx /(scot %p our.bowl)/boke/(scot %da now.bowl)/data/comments/json)
  =/  jj  %+  sort  (comment:de:js j)  |=  [a=read-comment b=read-comment]
  (lth date.a date.b)
  |-
    ?~  jj  state
    =/  a=read-comment  i.jj
    =/  c  (put:corm:tp *content-map:tp date.a contents.a)
    =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
      (add (bex 64) author.a)
    =/  pa  ?:  .=((cass (trip pa.a)) "spandrell")  ~docteg-mothep  
      (add (bex 64) pa.a)
    =/  pid  [author date.a]
    =/  ppid  [pa parent.a]
    =/  parent-post  (get:gorm:tp feed ppid)  
    =/  parent=(unit pid:tp)  ?~  parent-post  ~&  >  no-parent=[author.a date.a pa.a parent.a title.a]  ~
      `ppid
    =/  op  [~docteg-mothep post.a]
    =|  p=post:tp
    =.  p  %=  p
    id  date.a
    author  `@p`author
    contents  c
    tags  (sy ~['blog-comment'])
    ==
    =.  state  ?~  parent  state  
    =/  s  (save-reply p op u.parent .y)
     ?:  ?=(%err -.s)  state  +.s
    $(jj t.jj)


++  hi  bowl
::  cards
:: ++  send-dm
:: |=  who=@p
:: =/  input  %-  crip  "Show me what you got"
:: =/  parsed  (text-to-content input)
::   ~&  parsed=parsed
::   ?~  parsed  (alert-card:kaj "Text parsing failed")  
:: =/  content=story:c
:: :_  ~  :-  %inline  :_  ~  u.parsed
:: =/  id      [our.bowl now.bowl]
:: =/  =memo:c    [content our.bowl now.bowl]
:: =/  delta   [%add memo ~ ~]
:: =/  diff    [id delta]
:: =/  a  [who diff]
:: :*  %pass
::     /send
::     %agent
::     [our.bowl %chat]
::     %poke
::     %chat-dm-action
::     !>  a
:: ==

++  send-message
|=  input=inline:c
=/  content=story:c
:_  ~  :-  %inline  :_  ~  input
=/  =memo:c  [content src.bowl now.bowl]
=/  =kind-data:c  [%chat ~]
=/  =essay:c  [memo kind-data]
=/  cp=c-post:c  [%add essay]
=/  cc=c-channel:c  [%post cp]
=/  =nest:c  [%chat our.bowl %chat]
=/  a=c-channels:c  [%channel nest cc]
:*  %pass
    /send
    %agent
    [our.bowl %channels]
    %poke
    %channel-action
    !>  a
==
  ++  text-to-content
  %+  curr  rush
  |^  ;~  pose
        (cook |=(=@t [%link t t]) turl)
        text
      ==
  ++  turl
    =-  (sear - text)
    |=  t=cord
    ^-  (unit cord)
    ?~((rush t aurf:de-purl:html) ~ `t)
  ::  +text: text message body
  ::
  ++  text
    (cook crip (plus next))
  --
--