trying to use constraint programming to write music

music.hs

{-# OPTIONS_GHC -Wno-missing-methods #-}

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RankNTypes #-}

module Main where

import Lib
import Data.Hashable
import Data.Holmes
import GHC.Generics (Generic)
import Data.List

data Scale = Tonic | Supertonic | Mediant | Subdominant | Dominant | Submediant | Leading
  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)
  deriving anyclass (Hashable)

instance Num Scale where -- Syntactic sugar for numeric literals.
  fromInteger = toEnum . pred . fromInteger

windows :: Int -> [a] -> [[a]]
windows n xs = let wnds = map (take n) (tails xs)
                in filter (\x -> (length x) == n) wnds

listToPair :: [x] -> (x,x)
listToPair (l:ls) = (l, head ls)


listsToPairs :: [[x]] -> [(x,x)]
listsToPairs ls = map listToPair ls

pairs :: [x] -> [(x,x)]
pairs = listsToPairs . (windows 2)

absDiff :: Int -> Int -> Int
absDiff a b = abs (a-b)

numSteps :: [Scale] -> Int
numSteps s = let vs = map fromEnum s
                 prs = pairs vs
                 df = map (uncurry absDiff) prs
                 isOne = filter (\x -> x == 1) df
              in length isOne

numLeaps :: [Scale] -> Int
numLeaps s = let vs = map fromEnum s
                 prs = pairs vs
                 df = map (uncurry absDiff) prs
                 isOne = filter (\x -> x > 1) df
              in length isOne


constraints :: forall m. MonadCell m => [ Prop m (Intersect Scale) ] -> Prop m (Intersect Bool)
constraints board = ((.$) numSteps board ) .== 30


songConfig :: Config Holmes (Intersect Scale)
songConfig = 32 `from` [ 1 .. 7 ]

initSong :: Config Holmes (Intersect Scale)
initSong = let x = mempty in using
    [1,x,x,x, x,x,x,x, x,x,x,x, x,x,x,5,
     x,x,x,x, x,x,x,x, x,x,x,x, x,x,x,1]


songs :: IO (Maybe [ Intersect Scale])
songs = initSong `satisfying` constraints


main :: IO ()
main = do bla <- songs
          print bla