-- This file is part of Goatee.
--
-- Copyright 2014-2021 Bryan Gardiner
--
-- Goatee is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Goatee is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with Goatee.  If not, see <http://www.gnu.org/licenses/>.

-- | Functions for serializing SGF trees.
module Game.Goatee.Lib.Renderer.Tree (
  renderCollection,
  renderGameTree,
  renderProperty,
  ) where

import Control.Monad.Writer (tell)
import Game.Goatee.Common
import Game.Goatee.Lib.Property
import Game.Goatee.Lib.Renderer
import Game.Goatee.Lib.Tree

-- | Renders an SGF 'Collection' to a string.
renderCollection :: Collection -> Render ()
renderCollection :: Collection -> Render ()
renderCollection Collection
collection = do
  (Node -> Render ()) -> [Node] -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node -> Render ()
renderGameTree ([Node] -> Render ()) -> [Node] -> Render ()
forall a b. (a -> b) -> a -> b
$ Collection -> [Node]
collectionTrees Collection
collection
  [Char] -> Render ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char]
"\n"

-- | Recursively renders an SGF GameTree (as defined in the spec) rooted at the
-- given node.
renderGameTree :: Node -> Render ()
renderGameTree :: Node -> Render ()
renderGameTree Node
node = do
  [Char] -> Render ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char]
"("
  Node
-> (Node
    -> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node))
-> WriterT [Char] (Except [Char]) (Maybe [Node])
forall (m :: * -> *) a b.
Monad m =>
a -> (a -> m (Either b a)) -> m b
doWhileM Node
node
    (\Node
node' -> do Node -> Render ()
renderNode Node
node'
                  case Node -> [Node]
nodeChildren Node
node' of
                    [] -> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe [Node]) Node
 -> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node))
-> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall a b. (a -> b) -> a -> b
$ Maybe [Node] -> Either (Maybe [Node]) Node
forall a b. a -> Either a b
Left Maybe [Node]
forall a. Maybe a
Nothing
                    [Node
child] -> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe [Node]) Node
 -> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node))
-> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall a b. (a -> b) -> a -> b
$ Node -> Either (Maybe [Node]) Node
forall a b. b -> Either a b
Right Node
child
                    [Node]
children -> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe [Node]) Node
 -> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node))
-> Either (Maybe [Node]) Node
-> WriterT [Char] (Except [Char]) (Either (Maybe [Node]) Node)
forall a b. (a -> b) -> a -> b
$ Maybe [Node] -> Either (Maybe [Node]) Node
forall a b. a -> Either a b
Left (Maybe [Node] -> Either (Maybe [Node]) Node)
-> Maybe [Node] -> Either (Maybe [Node]) Node
forall a b. (a -> b) -> a -> b
$ [Node] -> Maybe [Node]
forall a. a -> Maybe a
Just [Node]
children)
    WriterT [Char] (Except [Char]) (Maybe [Node])
-> (Maybe [Node] -> Render ()) -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Render () -> ([Node] -> Render ()) -> Maybe [Node] -> Render ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Render ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((Node -> Render ()) -> [Node] -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node -> Render ()
renderGameTree)
  [Char] -> Render ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char]
")"

-- | Renders a node and its properties without recurring to its children.
renderNode :: Node -> Render ()
renderNode :: Node -> Render ()
renderNode Node
node = do
  [Char] -> Render ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char]
"\n;"
  (Property -> Render ()) -> [Property] -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Property -> Render ()
renderProperty ([Property] -> Render ()) -> [Property] -> Render ()
forall a b. (a -> b) -> a -> b
$ Node -> [Property]
nodeProperties Node
node

renderProperty :: Property -> Render ()
renderProperty :: Property -> Render ()
renderProperty Property
property = do
  [Char] -> Render ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Char] -> Render ()) -> [Char] -> Render ()
forall a b. (a -> b) -> a -> b
$ Property -> [Char]
forall a. Descriptor a => a -> [Char]
propertyName Property
property
  Property -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRenderer Property
property Property
property