module Prettify where

data Doc = Empty
         | Char Char
         | Text String
         | Line
         | Concat Doc Doc
         | Union Doc Doc
           deriving (Show,Eq)

punctuate :: Doc -> [Doc] -> [Doc]
punctuate p []     = []
punctuate p [d]    = [d]
punctuate p (d:ds) = (d <> p) : punctuate p ds


empty :: Doc
empty = Empty

char :: Char -> Doc
char c = Char c

text :: String -> Doc
text "" = Empty
text s = Text s

double :: Double -> Doc
double d = text (show d)

line :: Doc
line = Line

(<>) :: Doc -> Doc ->Doc
Empty <> y = y
x <> Empty = x
x <> y     = x `Concat` y

hcat :: [Doc] -> Doc
hcat = fold (<>) 

fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
fold f = foldr f empty

fsep :: [Doc] -> Doc
fsep = fold (</>)

(</>) :: Doc -> Doc -> Doc
--x </> Empty = x  -- Don't append a softline when the next value is empty 
x </> y     = x <> softline <> y

softline :: Doc
softline = group line

-- group is a coupling (union) of a Doc value with its flattened value
-- The flattened value is used for pretty printing
group :: Doc -> Doc
group x = flatten x `Union` x

-- flatten purges Unions  "right" value of Unions and replaces each Lines with a space.
-- THe constituent parts of all Concat values are flattened
flatten :: Doc -> Doc
flatten (x `Concat` y) = flatten x `Concat` flatten y
flatten Line           = Char ' '
flatten (x `Union` _)  = flatten x
flatten other          = other


-- compact generates a String representation of a Doc
--   Lines are coverted to a linefeed character and
--   Unions use the compacted form of their "right" or pure values
--   Concats are appeneded together
compact :: Doc -> String
compact x = transform [x]
    where transform [] = ""
          transform (d:ds) =
              case d of
                Empty        -> transform ds
                Char c       -> c : transform ds
                Text s       -> s ++ transform ds
                Line         -> '\n' : transform ds
                a `Concat` b -> transform (a:b:ds)
                _ `Union` b  -> transform (b:ds)

-- pretty generates a String representation of a Doc split into lines of a given width
--   Lines are coverted to a linefeed character and
--   Unions uses the "pretty" left value if it fits otherwise it uses the 
--   Concats are appended together
pretty :: Int -> Doc -> String
pretty width x = best 0 [x]
    where best col (d:ds) =
              case d of
                Empty        -> best col ds
                Char c       -> c :  best (col + 1) ds
                Text s       -> s ++ best (col + length s) ds
                Line         -> '\n' : best 0 ds
                a `Concat` b -> best col (a:b:ds)
                a `Union` b  -> nicest col (best col (a:ds))
                                           (best col (b:ds))
          best _ _ = ""

          nicest col a b | (width - least) `fits` a = a
                         | otherwise                = b
                         where least = min width col

-- fits check if the String fits the given limit
-- It is called with the current line width - current column
fits :: Int -> String -> Bool
w `fits` _ | w < 0 = False
w `fits` ""        = True
w `fits` ('\n':_)  = True
w `fits` (c:cs)    = (w - 1) `fits` cs

-- fill splits the Doc up at each Line and pads each one to the appropriate width
fill2 :: Int -> Doc -> Doc
fill2 width d = scanLines 0 [d]
    where scanLines col (d:ds) =
              case d of
                Empty        -> Empty <> scanLines col ds
                Char c       -> d <> scanLines (col + 1) ds
                Text s       -> d <> scanLines (col + length s) ds
                Line         -> (padLine col <> Line) <> scanLines 0 ds
                a `Concat` b -> scanLines col (a:b:ds)
                a `Union` b  -> scanLines col (a:ds) `Union`  scanLines col (b:ds)
          scanLines _ _ = Empty
          padLine pos = text $ replicate (width - pos) ' '

-- Let compact create a string representation of Doc, 
-- break each line into a string then 
-- recreate a new Doc appending the appropriate padding at the end of each line
fill2 :: Int -> Doc -> Doc
fill2 n d = fsep $ map padLine docLines
    where docLines  = lines (compact d)
          padLine l = text $ l ++ (replicate (n - length l) ' ')



nest :: Int -> Doc -> Doc
nest indent d = scanLines 0 [d]
    where scanLines col (d:ds) =
              case d of
                Empty        -> d <> scanLines col ds
                Char c       -> d <> scanLines (col + offset c) ds
                Text s       -> d <> scanLines col ds
                Line         -> d <> indentLine col <> scanLines col ds
                a `Concat` b -> scanLines col (a:b:ds)
                a `Union` b  -> scanLines col (a:ds) `Union`  scanLines col (b:ds)
          scanLines _ _        = Empty

          indentLine pos    = text $ replicate pos ' '
          offset c | c `elem` "{[" = indent
                   | c `elem` "}]" = negate indent
                   | otherwise     = 0