-- 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/>.

{-# LANGUAGE CPP #-}

-- | SGF data structures modelling the hierarchical game tree.
module Game.Goatee.Lib.Tree (
  Collection(..), CollectionWithDeepEquality(..),
  Node(..), NodeWithDeepEquality(..),
  emptyNode, rootNode,
  findProperty, findProperty', findPropertyValue, findPropertyValue',
  addProperty, addChild, addChildAt, deleteChildAt,
  validateNode,
  ) where

import Control.Monad (forM_, unless, when)
import Control.Monad.Writer (Writer, execWriter, tell)
import Data.Function (on)
import Data.List (find, groupBy, intercalate, nub, sortBy)
import Data.Ord (comparing)
import Data.Version (showVersion)
import Game.Goatee.App (applicationName)
import Game.Goatee.Common
import Game.Goatee.Lib.Property
import Game.Goatee.Lib.Types
import Paths_goatee (version)

-- | An SGF collection of game trees.
data Collection = Collection
  { Collection -> [Node]
collectionTrees :: [Node]
  } deriving (Int -> Collection -> ShowS
[Collection] -> ShowS
Collection -> String
(Int -> Collection -> ShowS)
-> (Collection -> String)
-> ([Collection] -> ShowS)
-> Show Collection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Collection] -> ShowS
$cshowList :: [Collection] -> ShowS
show :: Collection -> String
$cshow :: Collection -> String
showsPrec :: Int -> Collection -> ShowS
$cshowsPrec :: Int -> Collection -> ShowS
Show)

-- | See 'NodeWithDeepEquality'.
newtype CollectionWithDeepEquality = CollectionWithDeepEquality
  { CollectionWithDeepEquality -> Collection
collectionWithDeepEquality :: Collection
  } deriving (Int -> CollectionWithDeepEquality -> ShowS
[CollectionWithDeepEquality] -> ShowS
CollectionWithDeepEquality -> String
(Int -> CollectionWithDeepEquality -> ShowS)
-> (CollectionWithDeepEquality -> String)
-> ([CollectionWithDeepEquality] -> ShowS)
-> Show CollectionWithDeepEquality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectionWithDeepEquality] -> ShowS
$cshowList :: [CollectionWithDeepEquality] -> ShowS
show :: CollectionWithDeepEquality -> String
$cshow :: CollectionWithDeepEquality -> String
showsPrec :: Int -> CollectionWithDeepEquality -> ShowS
$cshowsPrec :: Int -> CollectionWithDeepEquality -> ShowS
Show)

instance Eq CollectionWithDeepEquality where
  == :: CollectionWithDeepEquality -> CollectionWithDeepEquality -> Bool
(==) = [NodeWithDeepEquality] -> [NodeWithDeepEquality] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([NodeWithDeepEquality] -> [NodeWithDeepEquality] -> Bool)
-> (CollectionWithDeepEquality -> [NodeWithDeepEquality])
-> CollectionWithDeepEquality
-> CollectionWithDeepEquality
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Node -> NodeWithDeepEquality) -> [Node] -> [NodeWithDeepEquality]
forall a b. (a -> b) -> [a] -> [b]
map Node -> NodeWithDeepEquality
NodeWithDeepEquality ([Node] -> [NodeWithDeepEquality])
-> (CollectionWithDeepEquality -> [Node])
-> CollectionWithDeepEquality
-> [NodeWithDeepEquality]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collection -> [Node]
collectionTrees (Collection -> [Node])
-> (CollectionWithDeepEquality -> Collection)
-> CollectionWithDeepEquality
-> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectionWithDeepEquality -> Collection
collectionWithDeepEquality

-- | An SGF game tree node.  Unlike in the SGF spec, we represent a game tree
-- with nodes uniformly, rather than having the separation between sequences and
-- nodes.
data Node = Node
  { Node -> [Property]
nodeProperties :: [Property]
  , Node -> [Node]
nodeChildren :: [Node]
  } deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)

-- | A wrapper around 'Node' with an 'Eq' instance that considers two nodes
-- equal iff they contain the same properties (not necessarily in the same
-- order), and if they contain children (in the same order) whose nodes are
-- recursively equal.
--
-- This instance is not on 'Node' directly because it is not the only obvious
-- sense of equality (only comparing properties would be another one), and it's
-- also potentially expensive.
newtype NodeWithDeepEquality = NodeWithDeepEquality { NodeWithDeepEquality -> Node
nodeWithDeepEquality :: Node }

instance Eq NodeWithDeepEquality where
  NodeWithDeepEquality
node1 == :: NodeWithDeepEquality -> NodeWithDeepEquality -> Bool
== NodeWithDeepEquality
node2 =
    let n1 :: Node
n1 = NodeWithDeepEquality -> Node
nodeWithDeepEquality NodeWithDeepEquality
node1
        n2 :: Node
n2 = NodeWithDeepEquality -> Node
nodeWithDeepEquality NodeWithDeepEquality
node2
    in Node -> [Property]
propertiesSorted Node
n1 [Property] -> [Property] -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> [Property]
propertiesSorted Node
n2 Bool -> Bool -> Bool
&&
       Node -> [NodeWithDeepEquality]
deepChildren Node
n1 [NodeWithDeepEquality] -> [NodeWithDeepEquality] -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> [NodeWithDeepEquality]
deepChildren Node
n2
    where propertiesSorted :: Node -> [Property]
propertiesSorted = (Property -> Property -> Ordering) -> [Property] -> [Property]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Property -> String) -> Property -> Property -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Property -> String
forall a. Show a => a -> String
show) ([Property] -> [Property])
-> (Node -> [Property]) -> Node -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Property]
nodeProperties
          deepChildren :: Node -> [NodeWithDeepEquality]
deepChildren = (Node -> NodeWithDeepEquality) -> [Node] -> [NodeWithDeepEquality]
forall a b. (a -> b) -> [a] -> [b]
map Node -> NodeWithDeepEquality
NodeWithDeepEquality ([Node] -> [NodeWithDeepEquality])
-> (Node -> [Node]) -> Node -> [NodeWithDeepEquality]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
nodeChildren

-- | A node with no properties and no children.
emptyNode :: Node
emptyNode :: Node
emptyNode = Node :: [Property] -> [Node] -> Node
Node { nodeProperties :: [Property]
nodeProperties = [], nodeChildren :: [Node]
nodeChildren = [] }

-- | Returns a fresh root 'Node' with 'AP' set to Goatee and optionally with a
-- board size set via 'SZ'.
rootNode :: Maybe (Int, Int) -> Node
rootNode :: Maybe (Int, Int) -> Node
rootNode Maybe (Int, Int)
maybeSize =
  let props :: [Property]
props = Int -> Property
FF Int
4 Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:
              Int -> Property
GM Int
1 Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:
              SimpleText -> SimpleText -> Property
AP (String -> SimpleText
toSimpleText String
applicationName)
                 (String -> SimpleText
toSimpleText (String -> SimpleText) -> String -> SimpleText
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version) Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:
              [Property]
-> ((Int, Int) -> [Property]) -> Maybe (Int, Int) -> [Property]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
:[]) (Property -> [Property])
-> ((Int, Int) -> Property) -> (Int, Int) -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Property) -> (Int, Int) -> Property
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Property
SZ) Maybe (Int, Int)
maybeSize
  in Node :: [Property] -> [Node] -> Node
Node { nodeProperties :: [Property]
nodeProperties = [Property]
props
          , nodeChildren :: [Node]
nodeChildren = []
          }

-- | Searches for a matching property in a node's property list.
findProperty :: Descriptor a => a -> Node -> Maybe Property
findProperty :: a -> Node -> Maybe Property
findProperty a
descriptor Node
node = a -> [Property] -> Maybe Property
forall a. Descriptor a => a -> [Property] -> Maybe Property
findProperty' a
descriptor ([Property] -> Maybe Property) -> [Property] -> Maybe Property
forall a b. (a -> b) -> a -> b
$ Node -> [Property]
nodeProperties Node
node

-- | Searches for a matching property in a property list.
findProperty' :: Descriptor a => a -> [Property] -> Maybe Property
findProperty' :: a -> [Property] -> Maybe Property
findProperty' = (Property -> Bool) -> [Property] -> Maybe Property
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Property -> Bool) -> [Property] -> Maybe Property)
-> (a -> Property -> Bool) -> a -> [Property] -> Maybe Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate

-- | Retrieves the value of a property in a node's property list.
findPropertyValue :: ValuedDescriptor v a => a -> Node -> Maybe v
findPropertyValue :: a -> Node -> Maybe v
findPropertyValue a
descriptor Node
node = a -> Property -> v
forall v a. ValuedDescriptor v a => a -> Property -> v
propertyValue a
descriptor (Property -> v) -> Maybe Property -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Node -> Maybe Property
forall a. Descriptor a => a -> Node -> Maybe Property
findProperty a
descriptor Node
node

-- | Retrieves the value of a property in a property list.
findPropertyValue' :: ValuedDescriptor v a => a -> [Property] -> Maybe v
findPropertyValue' :: a -> [Property] -> Maybe v
findPropertyValue' a
descriptor [Property]
properties =
  a -> Property -> v
forall v a. ValuedDescriptor v a => a -> Property -> v
propertyValue a
descriptor (Property -> v) -> Maybe Property -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [Property] -> Maybe Property
forall a. Descriptor a => a -> [Property] -> Maybe Property
findProperty' a
descriptor [Property]
properties

-- | Appends a property to a node's property list.
addProperty :: Property -> Node -> Node
addProperty :: Property -> Node -> Node
addProperty Property
prop Node
node = Node
node { nodeProperties :: [Property]
nodeProperties = Node -> [Property]
nodeProperties Node
node [Property] -> [Property] -> [Property]
forall a. [a] -> [a] -> [a]
++ [Property
prop] }

-- | @addChild child parent@ appends a child node to a node's child list.
addChild :: Node -> Node -> Node
addChild :: Node -> Node -> Node
addChild Node
child Node
node = Node
node { nodeChildren :: [Node]
nodeChildren = Node -> [Node]
nodeChildren Node
node [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node
child] }

-- | @addChildAt index child parent@ inserts a child node into a node's child
-- list at the given index, shifting all nodes at or after the given index to
-- the right.  If the position is less than 0 or greater than the length of the
-- list, then the index is clamped to this range.
addChildAt :: Int -> Node -> Node -> Node
addChildAt :: Int -> Node -> Node -> Node
addChildAt Int
index Node
child Node
node =
  let ([Node]
before, [Node]
after) = Int -> [Node] -> ([Node], [Node])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
index ([Node] -> ([Node], [Node])) -> [Node] -> ([Node], [Node])
forall a b. (a -> b) -> a -> b
$ Node -> [Node]
nodeChildren Node
node
  in Node
node { nodeChildren :: [Node]
nodeChildren = [Node]
before [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ Node
childNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
after }

-- | @deleteChildAt index node@ deletes the child at the given index from the
-- node.  If the index is invalid, @node@ is returned.
deleteChildAt :: Int -> Node -> Node
deleteChildAt :: Int -> Node -> Node
deleteChildAt Int
index Node
node =
  let children :: [Node]
children = Node -> [Node]
nodeChildren Node
node
  in if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Node] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node]
children
     then Node
node
     else Node
node { nodeChildren :: [Node]
nodeChildren = Int -> [Node] -> [Node]
forall a. Int -> [a] -> [a]
listDeleteAt Int
index [Node]
children }

-- | Returns a list of validation errors for the current node, an
-- empty list if no errors are detected.
validateNode :: Bool -> Bool -> Node -> [String]
validateNode :: Bool -> Bool -> Node -> [String]
validateNode Bool
isRoot Bool
_{-seenGameNode-} Node
node = Writer [String] () -> [String]
forall w a. Writer w a -> w
execWriter (Writer [String] () -> [String]) -> Writer [String] () -> [String]
forall a b. (a -> b) -> a -> b
$ do
  let props :: [Property]
props = Node -> [Property]
nodeProperties Node
node
  let propTypes :: [PropertyType]
propTypes = [PropertyType] -> [PropertyType]
forall a. Eq a => [a] -> [a]
nub ([PropertyType] -> [PropertyType])
-> [PropertyType] -> [PropertyType]
forall a b. (a -> b) -> a -> b
$ (Property -> PropertyType) -> [Property] -> [PropertyType]
forall a b. (a -> b) -> [a] -> [b]
map Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType ([Property] -> [PropertyType]) -> [Property] -> [PropertyType]
forall a b. (a -> b) -> a -> b
$ Node -> [Property]
nodeProperties Node
node

  -- Check for move and setup properties in a single node.
  Bool -> Writer [String] () -> Writer [String] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PropertyType
MoveProperty PropertyType -> [PropertyType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PropertyType]
propTypes Bool -> Bool -> Bool
&& PropertyType
SetupProperty PropertyType -> [PropertyType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PropertyType]
propTypes) (Writer [String] () -> Writer [String] ())
-> Writer [String] () -> Writer [String] ()
forall a b. (a -> b) -> a -> b
$
    [String] -> Writer [String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"Node contains move and setup properties."]

  -- Check for root properties in non-root nodes.
  let rootProps :: [Property]
rootProps = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PropertyType
RootProperty PropertyType -> PropertyType -> Bool
forall a. Eq a => a -> a -> Bool
==) (PropertyType -> Bool)
-> (Property -> PropertyType) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType) [Property]
props
  Bool -> Writer [String] () -> Writer [String] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isRoot Bool -> Bool -> Bool
&& Bool -> Bool
not ([Property] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Property]
rootProps)) (Writer [String] () -> Writer [String] ())
-> Writer [String] () -> Writer [String] ()
forall a b. (a -> b) -> a -> b
$
    [String] -> Writer [String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([String] -> Writer [String] ()) -> [String] -> Writer [String] ()
forall a b. (a -> b) -> a -> b
$ (Property -> String) -> [Property] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Property
p -> String
"Root property found on non-root node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      Property -> String
forall a. Show a => a -> String
show Property
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".")
           [Property]
rootProps

  -- TODO Check for game-info properties.

  -- Check for coordinates marked multiple times.
  [Property]
-> (Property -> [((Int, Int), String)])
-> ([((Int, Int), String)] -> Writer [String] ())
-> Writer [String] ()
forall v t.
(Eq v, Ord v) =>
[Property]
-> (Property -> [(v, t)])
-> ([(v, t)] -> Writer [String] ())
-> Writer [String] ()
validateNodeDuplicates [Property]
props Property -> [((Int, Int), String)]
getMarkedCoords (([((Int, Int), String)] -> Writer [String] ())
 -> Writer [String] ())
-> ([((Int, Int), String)] -> Writer [String] ())
-> Writer [String] ()
forall a b. (a -> b) -> a -> b
$ \[((Int, Int), String)]
group ->
    [String] -> Writer [String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"Coordinate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (((Int, Int), String) -> (Int, Int)
forall a b. (a, b) -> a
fst (((Int, Int), String) -> (Int, Int))
-> ((Int, Int), String) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ [((Int, Int), String)] -> ((Int, Int), String)
forall a. [a] -> a
head [((Int, Int), String)]
group) String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
" is specified multiple times in properties " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((((Int, Int), String) -> String)
-> [((Int, Int), String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), String) -> String
forall a b. (a, b) -> b
snd [((Int, Int), String)]
group) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."]

  -- TODO Validate recursively.

  where getMarkedCoords :: Property -> [((Int, Int), String)]
getMarkedCoords (CR CoordList
cs) = CoordList -> String -> [((Int, Int), String)]
forall b. CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs String
"CR"
        getMarkedCoords (MA CoordList
cs) = CoordList -> String -> [((Int, Int), String)]
forall b. CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs String
"MA"
        getMarkedCoords (SL CoordList
cs) = CoordList -> String -> [((Int, Int), String)]
forall b. CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs String
"SL"
        getMarkedCoords (SQ CoordList
cs) = CoordList -> String -> [((Int, Int), String)]
forall b. CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs String
"SQ"
        getMarkedCoords (TR CoordList
cs) = CoordList -> String -> [((Int, Int), String)]
forall b. CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs String
"TR"
        getMarkedCoords Property
_ = []

        tagMarkedCoords :: CoordList -> b -> [((Int, Int), b)]
tagMarkedCoords CoordList
cs b
tag = ((Int, Int) -> ((Int, Int), b))
-> [(Int, Int)] -> [((Int, Int), b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int, Int)
x -> ((Int, Int)
x, b
tag)) ([(Int, Int)] -> [((Int, Int), b)])
-> [(Int, Int)] -> [((Int, Int), b)]
forall a b. (a -> b) -> a -> b
$ CoordList -> [(Int, Int)]
expandCoordList CoordList
cs

validateNodeDuplicates :: (Eq v, Ord v)
                          => [Property]
                          -> (Property -> [(v, t)])
                          -> ([(v, t)] -> Writer [String] ())
                          -> Writer [String] ()
validateNodeDuplicates :: [Property]
-> (Property -> [(v, t)])
-> ([(v, t)] -> Writer [String] ())
-> Writer [String] ()
validateNodeDuplicates [Property]
props Property -> [(v, t)]
getTaggedElts [(v, t)] -> Writer [String] ()
errAction =
  let groups :: [[(v, t)]]
groups = ((v, t) -> (v, t) -> Bool) -> [(v, t)] -> [[(v, t)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (v -> v -> Bool) -> ((v, t) -> v) -> (v, t) -> (v, t) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (v, t) -> v
forall a b. (a, b) -> a
fst) ([(v, t)] -> [[(v, t)]]) -> [(v, t)] -> [[(v, t)]]
forall a b. (a -> b) -> a -> b
$
               ((v, t) -> (v, t) -> Ordering) -> [(v, t)] -> [(v, t)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((v, t) -> v) -> (v, t) -> (v, t) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (v, t) -> v
forall a b. (a, b) -> a
fst) ([(v, t)] -> [(v, t)]) -> [(v, t)] -> [(v, t)]
forall a b. (a -> b) -> a -> b
$
               (Property -> [(v, t)]) -> [Property] -> [(v, t)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Property -> [(v, t)]
getTaggedElts [Property]
props
  in [[(v, t)]]
-> ([(v, t)] -> Writer [String] ()) -> Writer [String] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[(v, t)]]
groups (([(v, t)] -> Writer [String] ()) -> Writer [String] ())
-> ([(v, t)] -> Writer [String] ()) -> Writer [String] ()
forall a b. (a -> b) -> a -> b
$ \[(v, t)]
group ->
       Bool -> Writer [String] () -> Writer [String] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(v, t)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(v, t)] -> Bool) -> [(v, t)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(v, t)] -> [(v, t)]
forall a. [a] -> [a]
tail [(v, t)]
group) (Writer [String] () -> Writer [String] ())
-> Writer [String] () -> Writer [String] ()
forall a b. (a -> b) -> a -> b
$
         [(v, t)] -> Writer [String] ()
errAction [(v, t)]
group