-- Copyright 2017 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

module Ness.Patches where
import qualified Data.Map as Map
import qualified Util.Lists as Lists
import Global
import qualified Ness.Guitar as Guitar
import qualified Ness.Guitar.Patch as Guitar.Patch
import qualified Ness.Multiplate as Multiplate
import qualified Ness.Multiplate.Patch as Multiplate.Patch


patches :: Map Text Patch
patches :: Map Text Patch
patches = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn Patch -> Text
patchName forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map Instrument -> Patch
PGuitar [Instrument]
Guitar.Patch.instruments
    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Instrument -> Patch
PMultiplate [Instrument]
Multiplate.Patch.instruments

data Performance =
    Guitar Guitar.Instrument Guitar.Score
    | Multiplate Multiplate.Instrument Multiplate.Score
    deriving (Int -> Performance -> ShowS
[Performance] -> ShowS
Performance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Performance] -> ShowS
$cshowList :: [Performance] -> ShowS
show :: Performance -> String
$cshow :: Performance -> String
showsPrec :: Int -> Performance -> ShowS
$cshowsPrec :: Int -> Performance -> ShowS
Show)

data Patch = PGuitar Guitar.Instrument | PMultiplate Multiplate.Instrument
    deriving (Patch -> Patch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Patch -> Patch -> Bool
$c/= :: Patch -> Patch -> Bool
== :: Patch -> Patch -> Bool
$c== :: Patch -> Patch -> Bool
Eq, Eq Patch
Patch -> Patch -> Bool
Patch -> Patch -> Ordering
Patch -> Patch -> Patch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Patch -> Patch -> Patch
$cmin :: Patch -> Patch -> Patch
max :: Patch -> Patch -> Patch
$cmax :: Patch -> Patch -> Patch
>= :: Patch -> Patch -> Bool
$c>= :: Patch -> Patch -> Bool
> :: Patch -> Patch -> Bool
$c> :: Patch -> Patch -> Bool
<= :: Patch -> Patch -> Bool
$c<= :: Patch -> Patch -> Bool
< :: Patch -> Patch -> Bool
$c< :: Patch -> Patch -> Bool
compare :: Patch -> Patch -> Ordering
$ccompare :: Patch -> Patch -> Ordering
Ord, Int -> Patch -> ShowS
[Patch] -> ShowS
Patch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Patch] -> ShowS
$cshowList :: [Patch] -> ShowS
show :: Patch -> String
$cshow :: Patch -> String
showsPrec :: Int -> Patch -> ShowS
$cshowsPrec :: Int -> Patch -> ShowS
Show)

performanceName :: Performance -> Text
performanceName :: Performance -> Text
performanceName Performance
p = case Performance
p of
    Guitar Instrument
i Score
_ -> Text
"guitar-" forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
Guitar.iName Instrument
i
    Multiplate Instrument
i Score
_ -> Text
"multiplate-" forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
Multiplate.iName Instrument
i

patchName :: Patch -> Text
patchName :: Patch -> Text
patchName Patch
i = case Patch
i of
    PGuitar Instrument
i -> Text
"guitar-" forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
Guitar.iName Instrument
i
    PMultiplate Instrument
i -> Text
"multiplate-" forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
Multiplate.iName Instrument
i