{-| Pretty Printer Types -} module Urbit.Noun.Tank where import ClassyPrelude import Urbit.Noun.Conversions import Urbit.Noun.TH import Urbit.Noun.Convert import Urbit.Noun.Core -------------------------------------------------------------------------------- type Tang = [Tank] data TankTree = Leaf Tape | Plum Plum | Palm (Tape, Tape, Tape, Tape) [TankTree] | Rose (Tape, Tape, Tape) [TankTree] deriving (Eq, Ord, Show) newtype Tank = Tank { tankTree :: TankTree } deriving newtype (Eq, Ord, Show) instance ToNoun Tank where toNoun (Tank t) = toNoun t instance FromNoun Tank where parseNoun n@(Atom _) = do Cord txt <- parseNoun n pure $ Tank $ Leaf $ Tape txt parseNoun n = Tank <$> parseNoun n data WideFmt = WideFmt { delimit :: Cord, enclose :: Maybe (Cord, Cord) } deriving (Eq, Ord, Show) data TallFmt = TallFmt { intro :: Cord, indef :: Maybe (Cord, Cord) } deriving (Eq, Ord, Show) data PlumFmt = PlumFmt (Maybe WideFmt) (Maybe TallFmt) deriving (Eq, Ord, Show) type Plum = AtomCell Cord PlumTree data PlumTree = Para Cord [Cord] | Tree PlumFmt [Plum] | Sbrk Plum deriving (Eq, Ord, Show) deriveNoun ''WideFmt deriveNoun ''TallFmt deriveNoun ''PlumFmt deriveNoun ''TankTree deriveNoun ''PlumTree -------------------------------------------------------------------------------- data WashCfg = WashCfg { wcIndent :: Word , wcWidth :: Word } -------------------------------------------------------------------------------- wash :: WashCfg -> TankTree -> Wall wash _cfg t = [ram t] -- win :: WashCfg -> Tank -> Wall -- win = undefined flat :: Plum -> Tape flat = Tape . tshow ram :: TankTree -> Tape ram = \case Leaf tape -> tape Plum plum -> flat plum Palm (p,q,r,s) kids -> ram (Rose (p, q<>r, s) kids) Rose (p,q,r) kids -> q <> loop kids where loop [] = r loop [x] = ram x <> r loop (x:xs) = ram x <> p <> loop xs tankToText :: Tank -> Text tankToText (Tank t) = unlines $ fmap unTape $ wash (WashCfg 0 80) t textToTank :: Text -> Tank textToTank = Tank . Leaf . Tape {- ++ win |= {tab/@ edg/@} =. tac (act:ug tac) %- fix:ug =+ lug=`wall`~ |^ |- ^- wall ?- -.tac $leaf (rig p.tac) $plum (turn ~(tall plume p.tac) |=(=cord (trip cord))) $palm ?: fit (rig ram) ?~ q.tac (rig q.p.tac) ?~ t.q.tac (rig(tab (add 2 tab), lug $(tac i.q.tac)) q.p.tac) => .(q.tac `(list tank)`q.tac) =+ lyn=(mul 2 (lent q.tac)) =+ ^= qyr |- ^- wall ?~ q.tac lug %= ^$ tac i.q.tac tab (add tab (sub lyn 2)) lug $(q.tac t.q.tac, lyn (sub lyn 2)) == (wig(lug qyr) q.p.tac) :: $rose ?: fit (rig ram) =. lug |- ^- wall ?~ q.tac ?:(=(~ r.p.tac) lug (rig r.p.tac)) ^$(tac i.q.tac, lug $(q.tac t.q.tac), tab din) ?: =(~ q.p.tac) lug (wig q.p.tac) == :: ++ din (mod (add 2 tab) (mul 2 (div edg 3))) ++ fit (lte (lent ram) (sub edg tab)) ++ rig |= hom/tape ^- wall ?: (lte (lent hom) (sub edg tab)) [(runt [tab ' '] hom) lug] => .(tab (add tab 2), edg (sub edg 2)) =+ mut=(trim (sub edg tab) hom) :- (runt [(sub tab 2) ' '] ['\\' '/' (weld p.mut `_hom`['\\' '/' ~])]) => .(hom q.mut) |- ?~ hom :- %+ runt [(sub tab 2) ' '] ['\\' '/' (runt [(sub edg tab) ' '] ['\\' '/' ~])] lug => .(mut (trim (sub edg tab) hom)) [(runt [tab ' '] p.mut) $(hom q.mut)] :: ++ wig |= hom/tape ^- wall ?~ lug (rig hom) =+ lin=(lent hom) =+ wug=:(add 1 tab lin) ?. =+ mir=i.lug |- ?~ mir | ?|(=(0 wug) ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))) (rig hom) :: ^ XX regular form? [(runt [tab ' '] (weld hom `tape`[' ' (slag wug i.lug)])) t.lug] -- -- -} {- ++ re |_ tac/tank ++ ram ^- tape ?- -.tac $leaf p.tac $plum ~(flat plume p.tac) $palm ram(tac [%rose [p.p.tac (weld q.p.tac r.p.tac) s.p.tac] q.tac]) $rose %+ weld q.p.tac |- ^- tape ?~ q.tac r.p.tac =+ voz=$(q.tac t.q.tac) (weld ram(tac i.q.tac) ?~(t.q.tac voz (weld p.p.tac voz))) == :: ++ ug :: horrible hack |% ++ ace :: strip ctrl chars |= a=tape ^- tape ?~ a ~ ?: |((lth i.a 32) =(127 `@`i.a)) $(a t.a) [i.a $(a t.a)] :: ++ act :: pretend tapes |= tac=tank ^- tank ?- -.tac %leaf [%leaf (hew p.tac)] %plum tac :: XX consider %palm :+ %palm [(hew p.p.tac) (hew q.p.tac) (hew r.p.tac) (hew s.p.tac)] (turn q.tac act) %rose :+ %rose [(hew p.p.tac) (hew q.p.tac) (hew r.p.tac)] (turn q.tac act) == :: ++ fix :: restore tapes |= wol=wall %+ turn wol |=(a=tape (tufa `(list @c)``(list @)`a)) :: ++ hew :: pretend tape |=(a=tape `tape``(list @)`(tuba (ace a))) -- :: ++ win |= {tab/@ edg/@} =. tac (act:ug tac) %- fix:ug =+ lug=`wall`~ |^ |- ^- wall ?- -.tac $leaf (rig p.tac) $plum (turn ~(tall plume p.tac) |=(=cord (trip cord))) $palm ?: fit (rig ram) ?~ q.tac (rig q.p.tac) ?~ t.q.tac (rig(tab (add 2 tab), lug $(tac i.q.tac)) q.p.tac) => .(q.tac `(list tank)`q.tac) =+ lyn=(mul 2 (lent q.tac)) =+ ^= qyr |- ^- wall ?~ q.tac lug %= ^$ tac i.q.tac tab (add tab (sub lyn 2)) lug $(q.tac t.q.tac, lyn (sub lyn 2)) == (wig(lug qyr) q.p.tac) :: $rose ?: fit (rig ram) =. lug |- ^- wall ?~ q.tac ?:(=(~ r.p.tac) lug (rig r.p.tac)) ^$(tac i.q.tac, lug $(q.tac t.q.tac), tab din) ?: =(~ q.p.tac) lug (wig q.p.tac) == :: ++ din (mod (add 2 tab) (mul 2 (div edg 3))) ++ fit (lte (lent ram) (sub edg tab)) ++ rig |= hom/tape ^- wall ?: (lte (lent hom) (sub edg tab)) [(runt [tab ' '] hom) lug] => .(tab (add tab 2), edg (sub edg 2)) =+ mut=(trim (sub edg tab) hom) :- (runt [(sub tab 2) ' '] ['\\' '/' (weld p.mut `_hom`['\\' '/' ~])]) => .(hom q.mut) |- ?~ hom :- %+ runt [(sub tab 2) ' '] ['\\' '/' (runt [(sub edg tab) ' '] ['\\' '/' ~])] lug => .(mut (trim (sub edg tab) hom)) [(runt [tab ' '] p.mut) $(hom q.mut)] :: ++ wig |= hom/tape ^- wall ?~ lug (rig hom) =+ lin=(lent hom) =+ wug=:(add 1 tab lin) ?. =+ mir=i.lug |- ?~ mir | ?|(=(0 wug) ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))) (rig hom) :: ^ XX regular form? [(runt [tab ' '] (weld hom `tape`[' ' (slag wug i.lug)])) t.lug] -- -- -}