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

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

import Control.DeepSeq
import Data.List.Split
import GHC.Generics (Generic)
import Pretty.Color
import Text.Printf

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

class Pretty a where
  pretty :: a -> Doc

instance (Monoid Doc) where
  mempty = Col []

instance (Semigroup Doc) where
  a <> b = Col [a, b]

instance Pretty Doc where
  pretty = id

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

instance Pretty String where
  pretty = Lit Nothing

instance Pretty Float where
  pretty = pretty . Diagram 1 . (: [])

instance (Pretty a) => Pretty (Maybe a) where
  pretty maybeA =
    case maybeA of
      Nothing -> Lit Nothing "n/a"
      Just a -> pretty a

data Diagram a = Diagram Int a deriving (Functor, Show)

diagram :: Int -> a -> Diagram a
diagram = Diagram

instance Pretty (Diagram [Float]) where
  pretty (Diagram n (take n -> xs)) =
    Col (map (\c -> colorize c (Lit Nothing (plot c))) (mapFirst tail (chunksOf 2 (map discretize (0 : xs')))))
    where
      xs' = replicate (n - length xs) 0 ++ xs

      mapFirst f (x : xs) = f x : xs

      plot [n, m] = chart (max 1 n, max 1 m)
      plot [m] = chart (0, max 1 m)

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

      colorize' 0 = color Black
      colorize' 1 = color Green
      colorize' 2 = colorDull Yellow
      colorize' 3 = color Yellow
      colorize' 4 = color Red
      colorize' x = error (printf "Pretty.pretty.colorize': %d" x)

      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 x = error (printf "Pretty.pretty.chart: %x" (show x))

      discretize :: Float -> Int
      discretize x = round (x * 4)

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)