{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

module Pretty
  ( Doc (..),
    Pretty,
    pretty,
    diagram,
    module Pretty.Color,
    color,
    colorDull,
  )
where

import Pretty.Color

data Doc
  = Col [Doc]
  | Lit (Maybe (Intensity, Color)) String
  deriving (Show, Eq)

class Pretty a where
  pretty :: a -> Doc

instance Pretty Char where
  pretty = pretty . (: [])

instance Pretty String where
  pretty = Lit Nothing

diagram :: Int -> [Float] -> Doc
diagram w xs = Col (map chart (discretize xs'))
  where
    xs' = replicate (2 * w - length xs) 0 ++ reverse (take (2 * w) xs)

    chart :: (Int, Int) -> Doc
    chart n = colorize n (pretty (chart' n))

    chart' (0, 0) = '⠀'
    chart' (0, 1) = '⢀'
    chart' (0, 2) = '⢠'
    chart' (0, 3) = '⢰'
    chart' (0, 4) = '⢸'
    chart' (1, 0) = '⡀'
    chart' (1, 1) = '⣀'
    chart' (1, 2) = '⣠'
    chart' (1, 3) = '⣰'
    chart' (1, 4) = '⣸'
    chart' (2, 0) = '⡄'
    chart' (2, 1) = '⣄'
    chart' (2, 2) = '⣤'
    chart' (2, 3) = '⣴'
    chart' (2, 4) = '⣼'
    chart' (3, 0) = '⡆'
    chart' (3, 1) = '⣆'
    chart' (3, 2) = '⣦'
    chart' (3, 3) = '⣶'
    chart' (3, 4) = '⣾'
    chart' (4, 0) = '⡇'
    chart' (4, 1) = '⣇'
    chart' (4, 2) = '⣧'
    chart' (4, 3) = '⣷'
    chart' (4, 4) = '⣿'
    chart' _ = error "chart': argument >4 (or <0)"

    colorize (n, m) = colorize' (max n m)

    colorize' 0 = colorDull Green
    colorize' 1 = color Green
    colorize' 2 = colorDull Yellow
    colorize' 3 = color Yellow
    colorize' 4 = color Red
    colorize' _ = error "colorize': argument >4 (or <0)"

    discretize :: [Float] -> [(Int, Int)]
    discretize [] = []
    discretize (_ : []) = []
    discretize (x1 : x2 : xs) =
      (round (x1 * 4), round (x2 * 4)) : discretize xs

color :: Color -> Doc -> Doc
color c = color' (Vivid, c)

colorDull :: Color -> Doc -> Doc
colorDull c = color' (Dull, c)

color' :: (Intensity, Color) -> Doc -> Doc
color' c (Lit _ s) = Lit (Just c) s
color' c (Col ds) = Col (map (color' c) ds)