41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
module Stream (
|
|
Stream(..)
|
|
) where
|
|
|
|
import Data.List (intercalate)
|
|
|
|
data Stream a = Stream [(a, Stream a)] deriving Show
|
|
|
|
instance Semigroup (Stream a) where
|
|
(<>) (Stream []) b = b
|
|
(<>) (Stream pairs) b = Stream $ (\(a, stream) -> (a, stream <> b)) <$> pairs
|
|
|
|
instance Monoid (Stream a) where
|
|
mempty = fromList []
|
|
|
|
fromList :: [a] -> Stream a
|
|
fromList [] = Stream []
|
|
fromList (pair:pairs) = Stream [(pair, fromList pairs)]
|
|
|
|
infinite :: a -> Stream a
|
|
infinite a = Stream [(a, infinite a)]
|
|
|
|
showTree :: Show a => Stream a -> String
|
|
showTree = intercalate "\n" . getLines
|
|
where
|
|
getLines (Stream []) = ["●"]
|
|
getLines (Stream pairs) =
|
|
concat $ (\(a, stream) -> showElem a $ getLines stream) <$> pairs
|
|
|
|
showElem :: Show a => a -> [String] -> [String]
|
|
showElem _ [] = []
|
|
showElem a [l] = ["— " ++ show a ++ " —" ++ l]
|
|
showElem a (l:ls) =
|
|
let prefix = "─ " ++ show a ++ " ─┬" in
|
|
let padding = take (length prefix - 1) $ repeat ' ' in
|
|
(prefix ++ l) : (pad padding ls)
|
|
where
|
|
pad _ [] = []
|
|
pad padding [x] = [padding ++ '╰' : x]
|
|
pad padding (x:xs) = (padding ++ '├' : x) : (pad padding xs)
|