bunz-0.0.1: src/Beautifier.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Beautifier
  ( beautify
  , indent
  , firstString
  , splitAtHead
  ) where

import           Data.Monoid ((<>))
import qualified Data.String as S
import qualified Data.Text   as T

-- Doctest setup
-- $setup
-- >>> :set -XOverloadedStrings

type IndentationLevel = Int

indentation :: T.Text
indentation = "  "

newline :: T.Text
newline = "\n"

indent :: IndentationLevel -> T.Text -> T.Text
indent level str = T.replicate level indentation <> str

trimmedTail :: T.Text -> T.Text
trimmedTail = T.stripStart . T.tail

-- | Split the given string at its head while honouring escaped string.
-- Examples:
--
-- >>> splitAtHead "whatsup"
-- ("w","hatsup")
--
-- >>> splitAtHead "\nyeay"
-- ("\n","yeay")
splitAtHead :: T.Text -> (T.Text, T.Text)
splitAtHead "" = ("", "")
splitAtHead str@(T.head -> '\\') = T.splitAt 2 str
splitAtHead str = T.splitAt 1 str

-- | Extract string within double quotes `"` including the double quotes ignoring
-- the suffix after closing quote `"`
--
-- Examples:
--
-- >>> string False "\"test\"whatuppp"
-- "\"test\""
string :: Bool -> T.Text -> T.Text
string False str@(T.head -> '"') = "\"" <> string True (T.tail str)
string True str@(T.head -> '"') = "\""
string True str = let (head, tail) = splitAtHead str in head <> string True tail

-- | Extract the first string value starting from the front.
firstString :: T.Text -> T.Text
firstString str = string False str


-- | Check if the given character is a whitespace
isWhitespace x
  | x == ' ' = True
  | x == '\r' = True
  | x == '\n' = True
  | x == '\t' = True
  | otherwise = False

-- | Check if the given character is end of json value
isEndOfValue x
 | isWhitespace x = True
 | x == ',' = True
 | x == '}' = True
 | x == ']' = True
 | otherwise = False

-- | Extract json value from the given text
--
-- Examples
--
-- >>> extractJsonValue "123131}"
-- "123131"
--
-- >>> extractJsonValue "false,true,false]"
-- "false"
extractJsonValue :: T.Text -> T.Text
extractJsonValue = T.takeWhile (not . isEndOfValue)

-- |Beautify the given JSON text based on the current indentation level.
beautifyText :: IndentationLevel -> T.Text -> T.Text
beautifyText i str
  | str == "" = ""
  | head == ' ' = stripStartThenParse str
  | head == '\n' = stripStartThenParse str
  | head == '\t' = stripStartThenParse str
  | head == '{' = nextLineAfterOpening "{"
  | head == '[' = nextLineAfterOpening "["
  | head == '}' = nextLineAfterClosing "}"
  | head == ']' = nextLineAfterClosing "]"
  | head == ',' = "," <> newline <> indent i (beautifyText i (trimmedTail str))
  | head == '"' = let groupedString = firstString str
                      restOfTheString = T.drop (T.length groupedString) str
                  in groupedString <> beautifyText i restOfTheString
  | head == ':' = ": " <> beautifyText i (trimmedTail str)
  | otherwise = let value = extractJsonValue str
                in value <> beautifyText i (T.drop (T.length value) str)
  where
    head = T.head str
    stripStartThenParse = beautifyText i . T.stripStart
    nextLineAfterOpening token = token
      <> newline
      <> indent (i + 1) (beautifyText (i + 1) (trimmedTail str))
    nextLineAfterClosing token = newline
      <> indent (i - 1) token
      <> beautifyText (i - 1) (trimmedTail str)


beautify :: String -> String
beautify = T.unpack . beautifyText 0 . T.pack