diff --git a/chords.cabal b/chords.cabal index 1a9149c..a914980 100644 --- a/chords.cabal +++ b/chords.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ee4c89d7bed6b5301ea76804b74ab74db2265473402e362135317ea273e7ff33 +-- hash: f837b4f562ba53b2d2f26f2e7af5f96f55ac5c2865d732d975cabd9a52a90dc1 name: chords version: 0.1.0.0 @@ -51,8 +51,10 @@ library hs-source-dirs: src build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , containers + , generic-random , parsec default-language: Haskell2010 @@ -64,9 +66,11 @@ executable chords-exe app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , chords , containers + , generic-random , parsec default-language: Haskell2010 @@ -79,8 +83,10 @@ test-suite chords-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , chords , containers + , generic-random , parsec default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 49685bc..f56c417 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,8 @@ dependencies: - base >= 4.7 && < 5 - containers - parsec +- generic-random +- QuickCheck library: source-dirs: src diff --git a/src/Base/Core/Quality/IQuality.hs b/src/Base/Core/Quality/IQuality.hs index acd916e..6694b87 100644 --- a/src/Base/Core/Quality/IQuality.hs +++ b/src/Base/Core/Quality/IQuality.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} module Base.Core.Quality.IQuality ( Quality(..) , baseQuality ) where +import GHC.Generics +import Generic.Random +import Test.QuickCheck + import Common.Utils (modByFrom) data Quality @@ -11,7 +16,10 @@ data Quality | Minor | Diminished Int | Augmented Int - deriving Show + deriving (Show, Generic) + +instance Arbitrary Quality where + arbitrary = genericArbitrary uniform baseQuality :: Int -> Quality baseQuality n diff --git a/src/Base/Interval.hs b/src/Base/Interval.hs index a10dbb8..2d34f57 100644 --- a/src/Base/Interval.hs +++ b/src/Base/Interval.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} module Base.Interval ( Interval , getQuality @@ -9,9 +10,14 @@ module Base.Interval , jumpIntervalFromNote , (|+|) , (|-|) + , propInvertSum , invert ) where +import GHC.Generics +import Generic.Random +import Test.QuickCheck hiding (getSize) + import Base.Core.Accidental import Base.Core.Note import Base.Core.Quality.IQuality @@ -24,11 +30,23 @@ import Base.PitchClass import Common.Utils (modByFrom) -import Data.Maybe (fromJust) +import Data.Maybe (isJust, fromJust) data Interval = Interval { getQuality :: Quality , getSize :: Int - } + } deriving (Generic) + +-- TODO: change to use a Maybe returning smart constructor when +-- such a thing becomes avalible. +-- The implemention of arbitrary will look something like: +-- suchThatMap +-- (genericArbitrary uniform) +-- (\(size, quality) -> intConstructor size quality) +instance Arbitrary Interval where + arbitrary = suchThat (genericArbitrary uniform) (isJust . intervalToDistance) + +propInvertSum :: Interval -> Bool +propInvertSum i = invert i |+| i == intervalFrom Perfect 1 instance Eq Interval where int1 == int2 = intervalToDistance int1 == intervalToDistance int2