-- Copyright 2016 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

-- | Describe an Im 'Patch', from the sequencer's point of view.
module Perform.Im.Patch (
    Patch(..), patch
    , controls, attribute_map, elements
    , AttributeMap, make_attribute_map
) where
import qualified Util.Lens as Lens
import qualified Util.Pretty as Pretty
import qualified Derive.Attrs as Attrs
import qualified Instrument.Common as Common
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note

import           Global


data Patch = Patch {
    -- | Map supported controls to documentation.
    -- TODO maybe I need a separate one for pitch controls.
    Patch -> Map Control Text
patch_controls :: !(Map Control.Control Text)
    , Patch -> AttributeMap
patch_attribute_map :: !AttributeMap
    , Patch -> Set Text
patch_elements :: !(Set Note.Element)
    } deriving (Int -> Patch -> ShowS
[Patch] -> ShowS
Patch -> String
(Int -> Patch -> ShowS)
-> (Patch -> String) -> ([Patch] -> ShowS) -> Show Patch
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)

patch :: Patch
patch :: Patch
patch = Patch
    { patch_controls :: Map Control Text
patch_controls = Map Control Text
forall a. Monoid a => a
mempty
    , patch_attribute_map :: AttributeMap
patch_attribute_map = [(Attributes, ())] -> AttributeMap
forall a. [(Attributes, a)] -> AttributeMap a
Common.AttributeMap []
    , patch_elements :: Set Text
patch_elements = Set Text
forall a. Monoid a => a
mempty
    }

controls :: Patch :-> Map Control Text
controls = (Patch -> Map Control Text)
-> ((Map Control Text -> Map Control Text) -> Patch -> Patch)
-> Patch :-> Map Control Text
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Patch -> Map Control Text
patch_controls
    (\Map Control Text -> Map Control Text
f Patch
r -> Patch
r { patch_controls :: Map Control Text
patch_controls = Map Control Text -> Map Control Text
f (Patch -> Map Control Text
patch_controls Patch
r) })
attribute_map :: Patch :-> AttributeMap
attribute_map = (Patch -> AttributeMap)
-> ((AttributeMap -> AttributeMap) -> Patch -> Patch)
-> Patch :-> AttributeMap
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Patch -> AttributeMap
patch_attribute_map
    (\AttributeMap -> AttributeMap
f Patch
r -> Patch
r { patch_attribute_map :: AttributeMap
patch_attribute_map = AttributeMap -> AttributeMap
f (Patch -> AttributeMap
patch_attribute_map Patch
r) })
elements :: Patch :-> Set Text
elements = (Patch -> Set Text)
-> ((Set Text -> Set Text) -> Patch -> Patch) -> Patch :-> Set Text
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Patch -> Set Text
patch_elements
    (\Set Text -> Set Text
f Patch
r -> Patch
r { patch_elements :: Set Text
patch_elements = Set Text -> Set Text
f (Patch -> Set Text
patch_elements Patch
r) })

instance Pretty Patch where
    format :: Patch -> Doc
format (Patch Map Control Text
controls AttributeMap
attr_map Set Text
elements) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Patch"
        [ (Text
"controls", Map Control Text -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Map Control Text
controls)
        , (Text
"attribute_map", AttributeMap -> Doc
forall a. Pretty a => a -> Doc
Pretty.format AttributeMap
attr_map)
        , (Text
"elements", Set Text -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Set Text
elements)
        ]

-- | Since the synth understands Attributes directly, this is just a list of
-- supported Attributes along with their priority.
type AttributeMap = Common.AttributeMap ()

make_attribute_map :: [Attrs.Attributes] -> AttributeMap
make_attribute_map :: [Attributes] -> AttributeMap
make_attribute_map = [(Attributes, ())] -> AttributeMap
forall a. [(Attributes, a)] -> AttributeMap a
Common.attribute_map ([(Attributes, ())] -> AttributeMap)
-> ([Attributes] -> [(Attributes, ())])
-> [Attributes]
-> AttributeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attributes -> (Attributes, ()))
-> [Attributes] -> [(Attributes, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Attributes
a -> (Attributes
a, ()))