<commit_before>{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnicodeSyntax #-}

{-| This modules contains utility functions for constructing perfect trees for
    use in some of the tests and examples.
 -}
module LogicGrowsOnTrees.Utils.PerfectTree
    (
    -- * Tree generators
      perfectTree
    , trivialPerfectTree
    , numberOfLeaves
    -- * Arity and depth parameters
    , Arity(..)
    , ArityAndDepth(..)
    , makeArityAndDepthTermAtPositions
    , formArityAndDepth
    ) where

import Control.Applicative ((<$>),(<*>))
import Control.Monad (MonadPlus,msum)

import Data.List (genericReplicate)
import Data.Word (Word)

import System.Console.CmdTheLine

import Text.PrettyPrint (text)

import LogicGrowsOnTrees (Tree)
import LogicGrowsOnTrees.Utils.Word_
import LogicGrowsOnTrees.Utils.WordSum

--------------------------------------------------------------------------------
-------------------------- Arity and depth parameters --------------------------
--------------------------------------------------------------------------------

{-| Newtype wrapper for arities that has an 'ArgVal' instance that enforces that
    the arity be at least 2.
 -}
newtype Arity = Arity { getArity :: Word } deriving (Eq,Show)

instance ArgVal Arity where
    converter = (parseArity,prettyArity)
      where
        (parseWord_,prettyWord_) = converter
        parseArity =
            either Left (\(Word_ n) →
                if n >= 2
                    then Right . Arity $ n
                    else Left . text $ "tree arity must be at least 2 (not " ++ show n ++ ")"
            )
            .
            parseWord_
        prettyArity = prettyWord_ . Word_ . getArity
instance ArgVal (Maybe Arity) where
    converter = just

{-| Datatype representing the arity and depth of a tree, used for command line
    argument processing (see 'makeArityAndDepthTermAtPositions').
 -}
data ArityAndDepth = ArityAndDepth
    {   arity :: !Word
    ,   depth :: !Word
    } deriving (Eq, Show)

{-| Constructs a configuration term that expects the arity and depth to be at
    the given command line argument positions.
 -}
makeArityAndDepthTermAtPositions ::
    Int {-^ the position of the arity parameter in the command line -} →
    Int {-^ the position of the depth parameter in the command line -} →
    Term ArityAndDepth
makeArityAndDepthTermAtPositions arity_position depth_position =
    formArityAndDepth
    <$> (required $
         pos arity_position
             Nothing
             posInfo
               { posName = "ARITY"<commit_msg>Now Arity and ArityAndDepth are serializable.<commit_after>{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}

{-| This modules contains utility functions for constructing perfect trees for
    use in some of the tests and examples.
 -}
module LogicGrowsOnTrees.Utils.PerfectTree
    (
    -- * Tree generators
      perfectTree
    , trivialPerfectTree
    , numberOfLeaves
    -- * Arity and depth parameters
    , Arity(..)
    , ArityAndDepth(..)
    , makeArityAndDepthTermAtPositions
    , formArityAndDepth
    ) where

import Control.Applicative ((<$>),(<*>))
import Control.Monad (MonadPlus,msum)

import Data.Derive.Serialize
import Data.DeriveTH
import Data.List (genericReplicate)
import Data.Serialize
import Data.Word (Word)

import System.Console.CmdTheLine

import Text.PrettyPrint (text)

import LogicGrowsOnTrees (Tree)
import LogicGrowsOnTrees.Utils.Word_
import LogicGrowsOnTrees.Utils.WordSum

--------------------------------------------------------------------------------
-------------------------- Arity and depth parameters --------------------------
--------------------------------------------------------------------------------

{-| Newtype wrapper for arities that has an 'ArgVal' instance that enforces that
    the arity be at least 2.
 -}
newtype Arity = Arity { getArity :: Word } deriving (Eq,Show,Serialize)

instance ArgVal Arity where
    converter = (parseArity,prettyArity)
      where
        (parseWord_,prettyWord_) = converter
        parseArity =
            either Left (\(Word_ n) →
                if n >= 2
                    then Right . Arity $ n
                    else Left . text $ "tree arity must be at least 2 (not " ++ show n ++ ")"
            )
            .
            parseWord_
        prettyArity = prettyWord_ . Word_ . getArity
instance ArgVal (Maybe Arity) where
    converter = just

{-| Datatype representing the arity and depth of a tree, used for command line
    argument processing (see 'makeArityAndDepthTermAtPositions').
 -}
data ArityAndDepth = ArityAndDepth
    {   arity :: !Word
    ,   depth :: !Word
    } deriving (Eq, Show)
$( derive makeSerialize ''ArityAndDepth )

{-| Constructs a configuration term that expects the arity and depth to be at
    the given command line argument positions.
 -}
makeArityAndDepthTermAtPositions ::
    Int {-^ the position of the arity parameter in the command line -} →
    Int {-^ the position of the depth parameter in the command line -} →
    Term ArityAndDepth
makeArityAndDepthTermAtPositions arity_position depth_position =
    formArityAndDepth
    <$> (required $
         pos arity_position
             Nothing
             posInfo
               { posName = "ARITY"
{'fraction_non_alphanumeric': 0.15414436034705556, 'fraction_numerical': 0.0011076241462063873, 'mean_word_length': 2.09954233409611, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5003779', 'n_tokens_mistral': 1522, 'n_tokens_neox': 1468, 'n_words': 465}