module Stream (
      Stream(..)
    , fromList
    , infinite
    , merge
    , showStream
  ) where

import Data.List (intercalate)

data Stream a = Stream [(a, Stream a)] deriving Show

empty :: Stream a
empty = fromList []

append :: Stream a -> Stream a -> Stream a
append (Stream []) b = b
append (Stream pairs) b = Stream $ (\(a, stream) -> (a, stream `append` b)) <$> pairs

fromList :: [a] -> Stream a
fromList [] = Stream []
fromList (pair:pairs) = Stream [(pair, fromList pairs)]

infinite :: a -> Stream a
infinite a = Stream [(a, infinite a)]

merge :: Eq a => Stream a -> Stream a -> Stream a
merge (Stream aPairs) (Stream bPairs) = Stream $ foldl mergeOrAdd aPairs bPairs
  where
    openAt _ l [] = (l, [])
    openAt p up l@(x:xs) = if p x then (up, l) else openAt p (x:up) xs
    zipUp ([], l) = l
    zipUp (x:xs, l) = zipUp (xs, x:l)
    mergeOrAdd accumulator (b, bStream) = zipUp $
      case openAt ((== b) . fst) [] accumulator of
        (up, []) -> (up, [(b, bStream)])
        (up, (x, xStream):down) -> (up, (x, merge xStream bStream):down)

showStream :: Show a => Stream a -> String
showStream = intercalate "\n" . getLines

getLines :: Show a => Stream a -> [String]
getLines (Stream []) = ["╼"]
getLines (Stream [(a, stream)]) = showBlock '─' (a, stream)
getLines (Stream ((a, stream):pairs)) = concat $
  showBlock '┬' (a, stream) : showBlocks pairs
  where
    showBlocks [] = []
    showBlocks [(a, stream)] = [showBlock '╰' (a, stream)]
    showBlocks ((a, stream):pairs) =
      showBlock '├' (a, stream) : showBlocks pairs

showBlock :: Show a => Char -> (a, Stream a) -> [String]
showBlock connectingChar (a, stream) =
  case getLines stream of
    [] -> []
    firstLine:otherLines -> (prefix ++ firstLine) : (pad <$> otherLines)
  where
    connect = ((if connectingChar `elem` "├┬" then '│' else ' '):)
    prefix = connectingChar : " " ++ show a ++ " "
    pad = connect . (take (length prefix - 1) (repeat ' ') ++)