gistfile1.txt

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}

module Lib where

import Control.Monad
import Data.Function
import Data.List

import Data.GenValidity
import Test.QuickCheck

import GHC.Generics

someFunc :: IO ()
someFunc = do
    sample (resize 20 $ genValid @(Tree Rational))

data Tree a
    = Empty
    | Node a
    | Branch [(String, Tree a)]
    deriving (Show, Eq, Generic)

instance Validity a => Validity (Tree a) where
    validate t =
        mconcat
            [ genericValidate t
            , declare "The keys are unique" $
              case t of
                  Branch ts' ->
                      let ts = map fst ts'
                      in length (nub ts) == length ts
                  _ -> True
            , declare "The strings consist of only 'a'" $
              case t of
                  Branch ts -> all (all (== 'a')) $ map fst ts
                  _ -> True
            ]

instance GenUnchecked a => GenUnchecked (Tree a) where
    genUnchecked =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ -> oneof [Node <$> genUnchecked, Branch <$> genUnchecked]

instance GenValid a => GenValid (Tree a) where
    genValid =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ ->
                    oneof
                        [ Node <$> genValid
                        , Branch <$>
                          (genDistinctList ((==) `on` fst) $
                           (,) <$> (genListOf $ pure 'a') <*> genValid)
                        ]

genDistinctList :: (a -> a -> Bool) -> Gen a -> Gen [a]
genDistinctList eq gen =
    sized $ \size -> do
        pars <- arbPartition size
        foldM go [] pars
  where
    go acc s = do
        a <- resize s $ gen `suchThat` (\a -> all (not . eq a) acc)
        pure $ a : acc


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}

module Lib where

import Control.Monad
import Data.Function
import Data.List

import Data.GenValidity
import Test.QuickCheck

import GHC.Generics

someFunc :: IO ()
someFunc = do
    sample (resize 20 $ genValid @(Tree Rational))

data Tree a
    = Empty
    | Node a
    | Branch [(String, Tree a)]
    deriving (Show, Eq, Generic)

instance Validity a => Validity (Tree a) where
    validate t =
        mconcat
            [ genericValidate t
            , declare "The keys are unique" $
              case t of
                  Branch ts' ->
                      let ts = map fst ts'
                      in length (nub ts) == length ts
                  _ -> True
            , declare "The strings consist of only 'a'" $
              case t of
                  Branch ts -> all (all (== 'a')) $ map fst ts
                  _ -> True
            ]

instance GenUnchecked a => GenUnchecked (Tree a) where
    genUnchecked =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ -> oneof [Node <$> genUnchecked, Branch <$> genUnchecked]

instance GenValid a => GenValid (Tree a) where
    genValid =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ ->
                    oneof
                        [ Node <$> genValid
                        , Branch <$>
                          (genDistinctList ((==) `on` fst) $
                           (,) <$> (genListOf $ pure 'a') <*> genValid)
                        ]

genDistinctList :: (a -> a -> Bool) -> Gen a -> Gen [a]
genDistinctList eq gen =
    sized $ \size -> do
        pars <- arbPartition size
        foldM go [] pars
  where
    go acc s = do
        a <- resize s $ gen `suchThat` (\a -> all (not . eq a) acc)
        pure $ a : acc
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}

module Lib where

import Control.Monad
import Data.Function
import Data.List

import Data.GenValidity
import Test.QuickCheck

import GHC.Generics

someFunc :: IO ()
someFunc = do
    sample (resize 20 $ genValid @(Tree Rational))

data Tree a
    = Empty
    | Node a
    | Branch [(String, Tree a)]
    deriving (Show, Eq, Generic)

instance Validity a => Validity (Tree a) where
    validate t =
        mconcat
            [ genericValidate t
            , declare "The keys are unique" $
              case t of
                  Branch ts' ->
                      let ts = map fst ts'
                      in length (nub ts) == length ts
                  _ -> True
            , declare "The strings consist of only 'a'" $
              case t of
                  Branch ts -> all (all (== 'a')) $ map fst ts
                  _ -> True
            ]

instance GenUnchecked a => GenUnchecked (Tree a) where
    genUnchecked =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ -> oneof [Node <$> genUnchecked, Branch <$> genUnchecked]

instance GenValid a => GenValid (Tree a) where
    genValid =
        sized $ \n ->
            case n of
                _
                    | n <= 0 -> pure Empty
                _ ->
                    oneof
                        [ Node <$> genValid
                        , Branch <$>
                          (genDistinctList ((==) `on` fst) $
                           (,) <$> (genListOf $ pure 'a') <*> genValid)
                        ]

genDistinctList :: (a -> a -> Bool) -> Gen a -> Gen [a]
genDistinctList eq gen =
    sized $ \size -> do
        pars <- arbPartition size
        foldM go [] pars
  where
    go acc s = do
        a <- resize s $ gen `suchThat` (\a -> all (not . eq a) acc)
        pure $ a : acc