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