module Argo.Encoder where

import qualified Argo.Literal as Literal
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Monad as Monad
import qualified Data.Functor.Identity as Identity
import qualified Data.Semigroup as Semigroup

type Encoder = Trans.ReaderT Config (Trans.WriterT Builder.Builder Identity.Identity)

data Config = Config
    { Config -> Indent
indent :: Indent
    , Config -> Int
level :: Int
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

data Indent
    = Spaces Int
    | Tab
    deriving (Indent -> Indent -> Bool
(Indent -> Indent -> Bool)
-> (Indent -> Indent -> Bool) -> Eq Indent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Indent -> Indent -> Bool
$c/= :: Indent -> Indent -> Bool
== :: Indent -> Indent -> Bool
$c== :: Indent -> Indent -> Bool
Eq, Int -> Indent -> ShowS
[Indent] -> ShowS
Indent -> String
(Int -> Indent -> ShowS)
-> (Indent -> String) -> ([Indent] -> ShowS) -> Show Indent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Indent] -> ShowS
$cshowList :: [Indent] -> ShowS
show :: Indent -> String
$cshow :: Indent -> String
showsPrec :: Int -> Indent -> ShowS
$cshowsPrec :: Int -> Indent -> ShowS
Show)

hasIndent :: Config -> Bool
hasIndent :: Config -> Bool
hasIndent Config
x = case Config -> Indent
indent Config
x of
    Spaces Int
y -> Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    Indent
Tab -> Bool
True

increaseLevel :: Config -> Config
increaseLevel :: Config -> Config
increaseLevel Config
x = Config
x { level :: Int
level = Config -> Int
level Config
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

list :: Encoder () -> Encoder () -> Encoder () -> (a -> Encoder ()) -> [a] -> Encoder ()
list :: Encoder ()
-> Encoder ()
-> Encoder ()
-> (a -> Encoder ())
-> [a]
-> Encoder ()
list Encoder ()
l Encoder ()
r Encoder ()
s a -> Encoder ()
f [a]
xs = case [a]
xs of
    [] -> do
        Encoder ()
l
        Encoder ()
r
    a
x : [a]
ys -> do
        Encoder ()
l
        Config
c <- ReaderT Config (WriterT Builder Identity) Config
forall (m :: * -> *) r. Monad m => ReaderT r m r
Trans.ask
        let newLine :: Builder
newLine = if Config -> Bool
hasIndent Config
c then Word8 -> Builder
Builder.word8 Word8
Literal.newLine else Builder
forall a. Monoid a => a
mempty
        (Config -> Config) -> Encoder () -> Encoder ()
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
Trans.local Config -> Config
increaseLevel (Encoder () -> Encoder ()) -> Encoder () -> Encoder ()
forall a b. (a -> b) -> a -> b
$ do
            Builder
i <- (Config -> Builder)
-> ReaderT Config (WriterT Builder Identity) Builder
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
Trans.asks Config -> Builder
makeIndent
            WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell (Builder -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Builder
newLine Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
i
            a -> Encoder ()
f a
x
            [a] -> (a -> Encoder ()) -> Encoder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [a]
ys ((a -> Encoder ()) -> Encoder ())
-> (a -> Encoder ()) -> Encoder ()
forall a b. (a -> b) -> a -> b
$ \ a
y -> do
                Encoder ()
s
                WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell (Builder -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Builder
newLine Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
i
                a -> Encoder ()
f a
y
        WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell (Builder -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Builder
newLine Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Config -> Builder
makeIndent Config
c
        Encoder ()
r

makeIndent :: Config -> Builder.Builder
makeIndent :: Config -> Builder
makeIndent Config
x = case Config -> Indent
indent Config
x of
    Spaces Int
y -> if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Builder
forall a. Monoid a => a
mempty else
        Int -> Builder -> Builder
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesMonoid (Config -> Int
level Config
x)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> Builder
forall a b. (Semigroup a, Integral b) => b -> a -> a
Semigroup.stimes Int
y
        (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.space
    Indent
Tab -> Int -> Builder -> Builder
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesMonoid (Config -> Int
level Config
x)
        (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.horizontalTabulation