{-# LANGUAGE DeriveGeneric #-}

module Data.NestedText.Serialize
  ( serialize
  , serialize'
  ) where

import qualified Data.Char as C
import Data.Functor.Identity (Identity(..))
import Data.List (intersperse)
import qualified Data.Map.Strict as M
import Data.Maybe (isJust)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Short as ST
import qualified Data.Vector as V
import Generic.Data
import Lens.Micro.Platform
import qualified Pipes.Text as PT

import Data.NestedText.Type
import Data.NestedText.Util

data Denote
  = Denote'Null
  | Denote'SingleLine T.Text
  | Denote'MultipleLine Item
  deriving ((forall x. Denote -> Rep Denote x)
-> (forall x. Rep Denote x -> Denote) -> Generic Denote
forall x. Rep Denote x -> Denote
forall x. Denote -> Rep Denote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Denote -> Rep Denote x
from :: forall x. Denote -> Rep Denote x
$cto :: forall x. Rep Denote x -> Denote
to :: forall x. Rep Denote x -> Denote
Generic)

serialize :: Int -> Item -> TL.Text
serialize :: Int -> Item -> Text
serialize Int
indentWidth = Builder -> Text
TLB.toLazyText (Builder -> Text) -> (Item -> Builder) -> Item -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item -> Builder
write
 where
  indent :: Int -> Builder
indent Int
i = String -> Builder
TLB.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' '
  nl :: Builder
nl = Text -> Builder
TLB.fromText Text
osNewline
  isMultilineKey :: ShortText -> Bool
isMultilineKey ShortText
ts =
    Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ((Char -> Bool) -> ShortText -> Maybe Int
ST.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') ShortText
ts)
    Bool -> Bool -> Bool
|| ShortText -> Bool
ST.null ShortText
ts
    Bool -> Bool -> Bool
|| (case ShortText -> Maybe (Char, ShortText)
ST.uncons ShortText
ts of
      Maybe (Char, ShortText)
Nothing -> Bool
False
      Just (Char
c, ShortText
_) -> Char -> Bool
C.isSpace Char
c Bool -> Bool -> Bool
|| Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsDict Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
    Bool -> Bool -> Bool
|| (case ShortText -> Maybe (ShortText, Char)
ST.unsnoc ShortText
ts of
      Maybe (ShortText, Char)
Nothing -> Bool
False
      Just (ShortText
_, Char
c) -> Char -> Bool
C.isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
    Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isInfixOf (String -> Text
T.pack String
": ") (ShortText -> Text
ST.toText ShortText
ts)
  denoteItem :: Item -> Denote
denoteItem item :: Item
item@(Item'String Text
ts) = case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
ts of
    Just Int
_ -> Item -> Denote
Denote'MultipleLine Item
item
    Maybe Int
Nothing -> if Text -> Bool
T.null Text
ts then Denote
Denote'Null else Text -> Denote
Denote'SingleLine Text
ts
  denoteItem Item
item = Item -> Denote
Denote'MultipleLine Item
item

  write :: Item -> Builder
write Item
i = Int -> Item -> Builder
writeItem Int
0 Item
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl
  writeItem :: Int -> Item -> Builder
writeItem Int
i (Item'String Text
ts) = Int -> Text -> Builder
writeString Int
i Text
ts
  writeItem Int
i (Item'List Vector Item
vs) = if Vector Item -> Bool
forall a. Vector a -> Bool
V.null Vector Item
vs
    then Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"[]"
    else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
nl
      ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ ((Item -> Builder) -> [Item] -> [Builder])
-> [Item] -> (Item -> Builder) -> [Builder]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Item -> Builder) -> [Item] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Item -> [Item]
forall a. Vector a -> [a]
V.toList Vector Item
vs) ((Item -> Builder) -> [Builder]) -> (Item -> Builder) -> [Builder]
forall a b. (a -> b) -> a -> b
$ \Item
vi -> case Item -> Denote
denoteItem Item
vi of
        Denote
Denote'Null -> Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"-"
        Denote'SingleLine Text
ts -> Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"- " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
ts
        Denote'MultipleLine Item
_ -> Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"-"
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Item -> Builder
writeItem (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentWidth) Item
vi
  writeItem Int
i (Item'Dictionary Map ShortText Item
dic) = if Map ShortText Item -> Bool
forall k a. Map k a -> Bool
M.null Map ShortText Item
dic
    then Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"{}"
    else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
nl
      ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (((ShortText, Item) -> Builder)
 -> [(ShortText, Item)] -> [Builder])
-> [(ShortText, Item)]
-> ((ShortText, Item) -> Builder)
-> [Builder]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ShortText, Item) -> Builder) -> [(ShortText, Item)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Map ShortText Item -> [(ShortText, Item)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map ShortText Item
dic) (((ShortText, Item) -> Builder) -> [Builder])
-> ((ShortText, Item) -> Builder) -> [Builder]
forall a b. (a -> b) -> a -> b
$ \(ShortText
k, Item
vi) -> if ShortText -> Bool
isMultilineKey ShortText
k
        then Int -> ShortText -> Builder
writeKey Int
i ShortText
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Item -> Builder
writeItem (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentWidth) Item
vi
        else case Item -> Denote
denoteItem Item
vi of
          Denote
Denote'Null ->
            Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText (ShortText -> Text
ST.toText ShortText
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
":"
          Denote'SingleLine Text
ts ->
            Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText (ShortText -> Text
ST.toText ShortText
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
": "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
ts
          Denote'MultipleLine Item
_ ->
            Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText (ShortText -> Text
ST.toText ShortText
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
":"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Item -> Builder
writeItem (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentWidth) Item
vi
  writeString :: Int -> Text -> Builder
writeString Int
i Text
ts =
    FreeT (Producer Text Identity) Identity () -> Identity [Text]
forall (m :: * -> *) r.
Monad m =>
FreeT (Producer Text m) m r -> m [Text]
freeTToLines (Producer Text Identity ()
-> FreeT (Producer Text Identity) Identity ()
forall (m :: * -> *) r.
Monad m =>
Producer Text m r -> FreeT (Producer Text m) m r
splitLines (Producer Text Identity ()
 -> FreeT (Producer Text Identity) Identity ())
-> Producer Text Identity ()
-> FreeT (Producer Text Identity) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Producer' Text Identity ()
forall (m :: * -> *). Monad m => Text -> Producer' Text m ()
PT.fromLazy (Text -> Producer' Text Identity ())
-> Text -> Producer' Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
ts)
    Identity [Text] -> (Identity [Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Identity [Text] -> [Text]
forall a. Identity a -> a
runIdentity
    [Text] -> ([Text] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
l -> if Text -> Bool
T.null Text
l
      then Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
">"
      else Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
"> " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
l)
    [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
nl
    [Builder] -> ([Builder] -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
& [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  writeKey :: Int -> ShortText -> Builder
writeKey Int
i ShortText
ts =
    FreeT (Producer Text Identity) Identity () -> Identity [Text]
forall (m :: * -> *) r.
Monad m =>
FreeT (Producer Text m) m r -> m [Text]
freeTToLines (Producer Text Identity ()
-> FreeT (Producer Text Identity) Identity ()
forall (m :: * -> *) r.
Monad m =>
Producer Text m r -> FreeT (Producer Text m) m r
splitLines (Producer Text Identity ()
 -> FreeT (Producer Text Identity) Identity ())
-> Producer Text Identity ()
-> FreeT (Producer Text Identity) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Producer' Text Identity ()
forall (m :: * -> *). Monad m => Text -> Producer' Text m ()
PT.fromLazy (Text -> Producer' Text Identity ())
-> Text -> Producer' Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ShortText -> Text
ST.toText ShortText
ts)
    Identity [Text] -> (Identity [Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Identity [Text] -> [Text]
forall a. Identity a -> a
runIdentity
    [Text] -> ([Text] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
l -> if Text -> Bool
T.null Text
l
      then Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
":"
      else Int -> Builder
indent Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString String
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
l)
    [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
nl
    [Builder] -> ([Builder] -> Builder) -> Builder
forall a b. a -> (a -> b) -> b
& [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat

serialize' :: Int -> Item -> T.Text
serialize' :: Int -> Item -> Text
serialize' Int
i = Text -> Text
TL.toStrict (Text -> Text) -> (Item -> Text) -> Item -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Item -> Text
serialize Int
i