import Control.Monad.Reader
import Partial.Unsafe (unsafeCrashWith)
import Data.Argonaut.Decode
import Data.Array (catMaybes, foldM, index, mapMaybe, zipWith, (..), filter)
import Data.Foldable (intercalate, null, length)
import Data.FunctorWithIndex
import Data.Function (on)
import Data.Int (toNumber, ceil)
import Data.Semigroup.Foldable (class Foldable1, foldMap1, fold1)
import Music.Transpose (class Transpose, trans)
newtype FingeringF a = Fingering
{ e4 :: a , b3 :: a , g3 :: a , d3 :: a , a2 :: a , e2 :: a }
instance eq_chord :: (Eq a) => Eq (FingeringF a) where
instance ord_chord :: (Ord a) => Ord (FingeringF a) where
compare = compare `on` toArray
instance functor_chord :: Functor FingeringF where
map f (Fingering x) = fingeringf
(f x.e4) (f x.b3) (f x.g3) (f x.d3) (f x.a2) (f x.e2)
instance functor_with_index_chord :: FunctorWithIndex Int FingeringF where
mapWithIndex f (Fingering x) = fingeringf
(f 0 x.e4) (f 1 x.b3) (f 2 x.g3) (f 3 x.d3) (f 4 x.a2) (f 5 x.e2)
instance apply_chord :: Apply FingeringF where
apply (Fingering f) (Fingering x) = fingeringf
(f.e4 x.e4) (f.b3 x.b3) (f.g3 x.g3) (f.d3 x.d3) (f.a2 x.a2) (f.e2 x.e2)
instance applicative_chord :: Applicative FingeringF where
pure x = fingeringf x x x x x x
instance foldable_chord :: Foldable FingeringF where
foldl f z chord = foldl f z $ toArray chord
foldr f z chord = foldr f z $ toArray chord
foldMap f chord = foldMap f $ toArray chord
instance traversable_chord :: Traversable FingeringF where
traverse f (Fingering x) = fingeringf
<$> f x.e4 <*> f x.b3 <*> f x.g3 <*> f x.d3 <*> f x.a2 <*> f x.e2
sequence = traverse identity
instance foldable1_chord :: Foldable1 FingeringF where
foldMap1 f (Fingering c) = f c.e4 <> f c.b3 <> f c.g3 <> f c.d3 <> f c.a2 <> f c.e2
fold1 = foldMap1 identity
fingeringf :: forall a. a -> a -> a -> a -> a -> a -> FingeringF a
fingeringf e4 b3 g3 d3 a2 e2 = Fingering { e4, b3, g3, d3, a2, e2 }
type Fingering = FingeringF GuitarString
instance show_fingering :: Show (FingeringF GuitarString) where
show = intercalate "-" <<< map (maybe "x" show <<< unfret) <<< toArray
instance transpose_fingering :: Transpose (FingeringF GuitarString) where
trans n fing = normaliseFingering $ map (trans n) fing
fingering e4 b3 g3 d3 a2 e2 =
if length (filter isFretted [e4, b3, g3, d3, a2, e2]) >= 1
then fingeringf e4 b3 g3 d3 a2 e2
fingeringError :: forall a. a
fingeringError = unsafeCrashWith "All fingerings must have have at least 1 note note (a zero note fingering is not really a fingering)"
fretRange :: Fingering -> Tuple Int Int
fretRange fing = fromMaybe fingeringError (Tuple <$> minimum frets <*> maximum frets)
where frets = catMaybes (map unfret $ toArray fing)
normaliseFingering :: Fingering -> Fingering
normaliseFingering fing = map (trans (12*octaveShift)) fing
octaveShift = ceil (- toNumber minFret / 12.0)
minFret = fst $ fretRange fing
toArray :: FingeringF ~> Array
toArray (Fingering c) = [c.e4, c.b3, c.g3, c.d3, c.a2, c.e2]
isOpen :: Fingering -> Boolean
validFingering :: Fingering -> Boolean
validFingering = all $ case _ of
Fret n -> 0 <= n && n <= 24