module Problem2d where

-- We just show how to solve the problem in the shallow
-- embedding. The same solution works for the deep embedding
-- by moving the code into the run function.

type Doc = Int -> [String]

ind :: Int -> [String] -> [String]
ind i = map (replicate i ' ' ++)

($$) :: Doc -> Doc -> Doc
(f $$ g) w = f w ++ g w

text :: String -> Doc
text s _ = [s]

empty :: Doc
empty _ = []

-- An interesting question is how to distribute the width
-- between the arguments to (<>). Here we choose to let
-- the first argument take as much space as it wants.
(<>) :: Doc -> Doc -> Doc
(f <> g) w = hcat (f w) g
  where
    hcat []  g = g w
    hcat [x] g = case g (w - i) of
      []     -> [x]
      y : ys -> (x ++ y) : ind i ys
      where
        i = length x
    hcat (x : xs) g = x : hcat xs g

cat :: Doc -> Doc -> Doc
cat f g w
  | width tryH > w = (f $$ g) w
  | otherwise      = tryH
  where
    tryH = (f <> g) w

    width [] = 0
    width xs = maximum $ map length xs

render :: Int -> Doc -> String
render w f = unlines (f w)

-- Derived combinators

indent :: Int -> Doc -> Doc
indent i f = text (replicate i ' ') <> f

(<+>) :: Doc -> Doc -> Doc
f <+> g = f <> indent 1 g