shrub/pkg/arvo/lib/easy-print.hoon

::  Fast type printing that's easy on the eyes or your money back
::
=>  |%
    ++  cape  {p/(map @ud wine) q/wine}
    ++  wine
      $@  $?  $noun
              $path
              $type
              $void
              $wall
              $wool
              $yarn
          ==
      $%  {$mato p/term}
          {$gate p/hoon q/type r/wine}
          {$core p/(list @ta) q/wine}
          {$face p/term q/wine}
          {$list p/term q/wine}
          {$pear p/term q/@}
          {$bswt p/(list wine)}
          {$plot p/(list wine)}
          {$stop p/@ud}
          {$tree p/term q/wine}
          {$unit p/term q/wine}
      ==
    --
|_  sut/type
++  dash
  |=  {mil/tape lim/char lam/tape}
  ^-  tape
  =/  esc  (~(gas in *(set @tD)) lam)
  :-  lim
  |-  ^-  tape
  ?~  mil  [lim ~]
  ?:  ?|  =(lim i.mil)
          =('\\' i.mil)
          (~(has in esc) i.mil)
      ==
    ['\\' i.mil $(mil t.mil)]
  ?:  (lte ' ' i.mil)
    [i.mil $(mil t.mil)]
  ['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)]
::
++  deal  |=(lum/* (dish dole lum))
++  dial
  |=  ham/cape
  =+  gid=*(set @ud)
  =|  top-level=?  ::  don't need circumfix punctuation
  =<  `tank`-:$
  |%
  ++  many
    |=  haz/(list wine)
    ^-  {(list tank) (set @ud)}
    ?~  haz  [~ gid]
    =^  mor  gid  $(haz t.haz)
    =^  dis  gid  ^$(q.ham i.haz)
    [[dis mor] gid]
  ::
  ++  $
    ^-  {tank (set @ud)}
    ?-    q.ham
        $noun      :_(gid [%leaf '*' ~])
        $path      :_(gid [%leaf '/' ~])
        $type      :_(gid [%leaf '#' 't' ~])
        $void      :_(gid [%leaf '#' '!' ~])
        $wool      :_(gid [%leaf '*' '"' '"' ~])
        $wall      :_(gid [%leaf '*' '\'' '\'' ~])
        $yarn      :_(gid [%leaf '"' '"' ~])
        {$mato *}  :_(gid [%leaf '@' (trip p.q.ham)])
        {$gate *}
      =^  sam  gid
        ?.  ?=([%plot * * *] r.q.ham)
          ?:  ?=(%plot -.r.q.ham)
            %-  (slog -:$(q.ham r.q.ham) ~)
            `gid
          `gid
        [`u=- +]:$(q.ham i.p.r.q.ham, top-level |)
      :_  gid
      :+  %rose
        :-  " -> "
        ?:  top-level
          ["" ""]
        ["(" ")"]
      :+  ?~(sam leaf+"_" u.sam)
        =/  res  (mule |.((~(play ut q.q.ham) p.q.ham)))
        ?-  -.res
          %&  duck(sut p.res)
          %|  leaf+"###"
        ==
      ~
    ::
        {$core *}
      =^  sam  gid
        ?.  ?=([%plot * * ~] q.q.ham)
          `gid
        [`u=- +]:$(q.ham i.p.q.q.ham)
      :_  gid
      ?~  sam
        :+  %rose
          [[' ' ~] ['<' ~] ['>' ~]]
        |-  ^-  (list tank)
        ?~  p.q.ham  ~
        [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
      :+  %rose
        [" -> " "" ""]
      :+  u.sam
        :+  %rose
          [[' ' ~] ['<' ~] ['>' ~]]
        |-  ^-  (list tank)
        ?~  p.q.ham  ~
        [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
      ~
    ::
        {$face *}
      =^  cox  gid  $(q.ham q.q.ham)
      :_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
    ::
        {$list *}
      =^  cox  gid  $(q.ham q.q.ham)
      :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
    ::
        {$bswt *}
      =^  coz  gid  (many p.q.ham)
      :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
    ::
        {$plot *}
      =^  coz  gid  (many p.q.ham)
      :_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz])
    ::
        {$pear *}
      :_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
    ::
        {$stop *}
      =+  num=~(rend co [%$ %ud p.q.ham])
      ?:  (~(has in gid) p.q.ham)
        :_(gid [%leaf '#' num])
      =^  cox  gid
          %=  $
            gid    (~(put in gid) p.q.ham)
            q.ham  (~(got by p.ham) p.q.ham)
          ==
      :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
    ::
        {$tree *}
      =^  cox  gid  $(q.ham q.q.ham)
      :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
    ::
        {$unit *}
      =^  cox  gid  $(q.ham q.q.ham)
      :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
    ==
  --
::
++  dish  !:
  |=  {ham/cape lum/*}  ^-  tank
  ~|  [%dish-h ?@(q.ham q.ham -.q.ham)]
  ~|  [%lump lum]
  ~|  [%ham ham]
  %-  need
  =|  gil/(set {@ud *})
  |-  ^-  (unit tank)
  ?-    q.ham
      $noun
    %=    $
        q.ham
      ?:  ?=(@ lum)
        [%mato %$]
      :-  %plot
      |-  ^-  (list wine)
      [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
    ==
  ::
      $path
    :-  ~
    :+  %rose
      [['/' ~] ['/' ~] ~]
    |-  ^-  (list tank)
    ?~  lum  ~
    ?@  lum  !!
    ?>  ?=(@ -.lum)
    [[%leaf (rip 3 -.lum)] $(lum +.lum)]
  ::
      $type
    =+  tyr=|.((dial dole))
    =+  vol=tyr(sut lum)
    =+  cis=;;(tank .*(vol [%9 2 %0 1]))
    :^  ~   %palm
      [~ ~ ~ ~]
    [[%leaf '#' 't' '/' ~] cis ~]
  ::
      $wall
    :-  ~
    :+  %rose
      [[' ' ~] ['<' '|' ~] ['|' '>' ~]]
    |-  ^-  (list tank)
    ?~  lum  ~
    ?@  lum  !!
    [[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
  ::
      $wool
    :-  ~
    :+  %rose
      [[' ' ~] ['<' '<' ~] ['>' '>' ~]]
    |-  ^-  (list tank)
    ?~  lum  ~
    ?@  lum  !!
    [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
  ::
      $yarn
    [~ %leaf (dash (tape lum) '"' "\{")]
  ::
      $void
    ~
  ::
      {$mato *}
    ?.  ?=(@ lum)
      ~
    :+  ~
      %leaf
    ?+    (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
        ~(rend co [%$ p.q.ham lum])
      $$    ~(rend co [%$ %ud lum])
      $t    (dash (rip 3 lum) '\'' ~)
      $tas  ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
    ==
  ::
      {$gate *}
    !!
  ::
      {$core *}
    ::  XX  needs rethinking for core metal
    ::  ?.  ?=(^ lum)  ~
    ::  =>  .(lum `*`lum)
    ::  =-  ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
    ::  ^=  tok
    ::  |-  ^-  (unit (list tank))
    ::  ?~  p.q.ham
    ::    =+  den=^$(q.ham q.q.ham)
    ::    ?~(den ~ [~ u.den ~])
    ::  =+  mur=$(p.q.ham t.p.q.ham, lum +.lum)
    ::  ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
    [~ (dial ham)]
  ::
      {$face *}
    =+  wal=$(q.ham q.q.ham)
    ?~  wal
      ~
    [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
  ::
      {$list *}
    ?:  =(~ lum)
      [~ %leaf '~' ~]
    =-  ?~  tok
          ~
        [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
    ^=  tok
    |-  ^-  (unit (list tank))
    ?:  ?=(@ lum)
      ?.(=(~ lum) ~ [~ ~])
    =+  [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
    ?.  &(?=(^ for) ?=(^ aft))
      ~
    [~ u.for u.aft]
  ::
      {$bswt *}
    |-  ^-  (unit tank)
    ?~  p.q.ham
      ~
    =+  wal=^$(q.ham i.p.q.ham)
    ?~  wal
      $(p.q.ham t.p.q.ham)
    wal
  ::
      {$plot *}
    =-  ?~  tok
          ~
        [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
    ^=  tok
    |-  ^-  (unit (list tank))
    ?~  p.q.ham
      ~
    ?:  ?=({* ~} p.q.ham)
      =+  wal=^$(q.ham i.p.q.ham)
      ?~(wal ~ [~ [u.wal ~]])
    ?@  lum
      ~
    =+  gim=^$(q.ham i.p.q.ham, lum -.lum)
    ?~  gim
      ~
    =+  myd=$(p.q.ham t.p.q.ham, lum +.lum)
    ?~  myd
      ~
    [~ u.gim u.myd]
  ::
      {$pear *}
    ?.  =(lum q.q.ham)
      ~
    =.  p.q.ham
      (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
    =+  fox=$(q.ham [%mato p.q.ham])
    ?>  ?=({~ $leaf ^} fox)
    ?:  ?=(?($n $tas) p.q.ham)
      fox
    [~ %leaf '%' p.u.fox]
  ::
      {$stop *}
    ?:  (~(has in gil) [p.q.ham lum])  ~
    =+  kep=(~(get by p.ham) p.q.ham)
    ?~  kep
      ~|([%stop-loss p.q.ham] !!)
    $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
  ::
      {$tree *}
    =-  ?~  tok
          ~
        [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
    ^=  tok
    =+  tuk=*(list tank)
    |-  ^-  (unit (list tank))
    ?:  =(~ lum)
      [~ tuk]
    ?.  ?=({n/* l/* r/*} lum)
      ~
    =+  rol=$(lum r.lum)
    ?~  rol
      ~
    =+  tim=^$(q.ham q.q.ham, lum n.lum)
    ?~  tim
      ~
    $(lum l.lum, tuk [u.tim u.rol])
  ::
      {$unit *}
    ?@  lum
      ?.(=(~ lum) ~ [~ %leaf '~' ~])
    ?.  =(~ -.lum)
      ~
    =+  wal=$(q.ham q.q.ham, lum +.lum)
    ?~  wal
      ~
    [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
  ==
::
++  doge
  |=  ham/cape
  =-  ?+  woz  woz
        {$list * {$mato $'ta'}}  %path
        {$list * {$mato $'t'}}   %wall
        {$list * {$mato $'tD'}}  %yarn
        {$list * $yarn}          %wool
      ==
  ^=  woz
  ^-  wine
  ?.  ?=({$stop *} q.ham)
    ?:  ?&  ?=  {$bswt {$pear $n $0} {$plot {$pear $n $0} {$face *} ~} ~}
              q.ham
            =(1 (met 3 p.i.t.p.i.t.p.q.ham))
        ==
      [%unit =<([p q] i.t.p.i.t.p.q.ham)]
    q.ham
  =+  may=(~(get by p.ham) p.q.ham)
  ?~  may
    q.ham
  =+  nul=[%pear %n 0]
  ?.  ?&  ?=({$bswt *} u.may)
          ?=({* * ~} p.u.may)
          |(=(nul i.p.u.may) =(nul i.t.p.u.may))
      ==
    q.ham
  =+  din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
  ?:  ?&  ?=({$plot {$face *} {$face * $stop *} ~} din)
          =(p.q.ham p.q.i.t.p.din)
          =(1 (met 3 p.i.p.din))
          =(1 (met 3 p.i.t.p.din))
      ==
    :+  %list
      (cat 3 p.i.p.din p.i.t.p.din)
    q.i.p.din
  ?:  ?&  ?=  $:  $plot
                  {$face *}
                  {$face * $stop *}
                  {{$face * $stop *} ~}
              ==
              din
          =(p.q.ham p.q.i.t.p.din)
          =(p.q.ham p.q.i.t.t.p.din)
          =(1 (met 3 p.i.p.din))
          =(1 (met 3 p.i.t.p.din))
          =(1 (met 3 p.i.t.t.p.din))
      ==
    :+  %tree
      %^    cat
          3
        p.i.p.din
      (cat 3 p.i.t.p.din p.i.t.t.p.din)
    q.i.p.din
  q.ham
::
++  dole
  ^-  cape
  =+  gil=*(set type)
  =+  dex=[p=*(map type @) q=*(map @ wine)]
  =<  [q.p q]
  |-  ^-  {p/{p/(map type @) q/(map @ wine)} q/wine}
  =-  [p.tez (doge q.p.tez q.tez)]
  ^=  tez
  ^-  {p/{p/(map type @) q/(map @ wine)} q/wine}
  =/  type-meet  (mule |.((~(meet ut sut) -:!>(*type))))
  ?:  ?=(%| -.type-meet)
    [dex %void]
  ?:  ?=(%& p.type-meet)
    [dex %type]
  ?-    sut
      $noun      [dex sut]
      $void      [dex sut]
      {$atom *}  [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
      {$cell *}
    =+  hin=$(sut p.sut)
    =+  yon=$(dex p.hin, sut q.sut)
    :-  p.yon
    :-  %plot
    ?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
  ::
      {$core *}
    ?:  ?=([[%$ * [[%$ @ *] ~ ~]] ~ ~] q.r.q.sut)
      =/  dad  $(sut p.sut)
      :-  p.dad
      ~!  q.r.q.sut
      [%gate q.n.q.q.n.q.r.q.sut sut(r.p.q %gold) q.dad]
    =+  yad=$(sut p.sut)
    :-  p.yad
    =+  ^=  doy  ^-  {p/(list @ta) q/wine}
        ?:  ?=({$core *} q.yad)
          [p.q.yad q.q.yad]
        [~ q.yad]
    :-  %core
    :_  q.doy
    :_  p.doy
    %^  cat  3
      %~  rent  co
      :+  %$  %ud
      %-  ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
      |=([[@ a=@u] b=@u] (add a b))
    %^  cat  3
      ?-(r.p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&')
    =+  gum=(mug q.r.q.sut)
    %+  can  3
    :~  [1 (add 'a' (mod gum 26))]
        [1 (add 'a' (mod (div gum 26) 26))]
        [1 (add 'a' (mod (div gum 676) 26))]
    ==
  ::
      {$hint *}
    $(sut q.sut)
  ::
      {$face *}
    =+  yad=$(sut q.sut)
    ?^(p.sut yad [p.yad [%face p.sut q.yad]])
  ::
      {$fork *}
    =+  yed=(sort ~(tap in p.sut) aor)
    =-  [p [%bswt q]]
    |-  ^-  {p/{p/(map type @) q/(map @ wine)} q/(list wine)}
    ?~  yed
      [dex ~]
    =+  mor=$(yed t.yed)
    =+  dis=^$(dex p.mor, sut i.yed)
    [p.dis q.dis q.mor]
  ::
      {$hold *}
    =+  hey=(~(get by p.dex) sut)
    ?^  hey
      [dex [%stop u.hey]]
    ?:  (~(has in gil) sut)
      =+  dyr=+(~(wyt by p.dex))
      [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
    =+  rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
    =+  rey=(~(get by p.p.rom) sut)
    ?~  rey
      rom
    [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
  ==
::
++  duck  (dial dole)
--