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

{- | Provide short names and operators for writing korvais in haskell.  This
    module is the shared global namespace between "Solkattu.Dsl.Solkattu" and
    "Solkattu.Dsl.Mridangam".

    Operators:

    > infixl 9 ^ § & -- also •, which replaces prelude (.)
    > infixl 8 <== ==>
    > infixr 6 . -- same as (<>)
-}
module Solkattu.Dsl.Generic (
    s
    , (.), (•), ø
    , mconcatMap
    , writeHtml
    -- * notation
    , karvai
    , stripRests

    -- * directives
    , hv, lt
    , akshara, sam, (§)
    -- * Config
    , wider
    , abstract, concrete
    , Abstraction
    , patterns, namedGroups, allAbstract
    -- * patterns
    , pat, p5, p6, p7, p8, p9, p666, p567, p765
    -- * re-exports
    , module Solkattu.Korvai
    , module Solkattu.Dsl.Metadata
    , module Solkattu.Dsl.Notation
    , module Solkattu.Dsl.Section
    , Duration, Matra, Nadai
    , check, durationOf, throw
    , Akshara
    -- * misc
    , pprint
    -- * talam
    , beats
    , adi
    -- * conveniences
    , ganesh, janahan, sudhindra, elaforge
    , Pretty -- signatures wind up being Pretty sollu => ...
) where
import qualified Prelude
import           Prelude hiding ((.), (^), repeat)

import qualified Util.CallStack as CallStack
import           Util.Pretty (pprint)
import qualified Solkattu.Format.Format as Format
import           Solkattu.Format.Format (Abstraction)
import qualified Solkattu.Format.Html as Html
import qualified Solkattu.Format.Terminal as Terminal
import qualified Solkattu.Korvai as Korvai
import           Solkattu.Korvai (Korvai, Score, tani, Part(..), index, slice)
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import           Solkattu.S (Duration, Matra, Nadai)
import qualified Solkattu.Solkattu as Solkattu
import           Solkattu.Solkattu (check, durationOf, throw)
import qualified Solkattu.Tala as Tala
import           Solkattu.Tala (Akshara)

import           Global
import           Solkattu.Dsl.Metadata
import           Solkattu.Dsl.Notation
import           Solkattu.Dsl.Section


-- | Declare a 'Section' of a 'Korvai'.
--
-- I tried to think of various ways to avoid having to explicitly wrap every
-- section, but they all seem really heavyweight, like a typeclass and replace
-- list literals with a custom (:) operator, or leaky, like embed section in
-- the Sequence and just pull out the topmost one.  So I'll settle for explicit
-- noise, but shorten the name.
s :: a -> Korvai.Section a
s :: forall a. a -> Section a
s = forall a. a -> Section a
section

-- | Combine 'Sequence's.  This is just another name for (<>).
(.) :: Monoid a => a -> a -> a
. :: forall a. Monoid a => a -> a -> a
(.) = forall a. Semigroup a => a -> a -> a
(<>)
infixr 6 . -- same as <>

-- | Composition is still useful though.
(•) :: (b -> c) -> (a -> b) -> a -> c
• :: forall b c a. (b -> c) -> (a -> b) -> a -> c
(•) = forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
infixr 9 • -- match prelude (.)

-- | Synonym for mempty.  Opt-o on OS X.  It looks a little bit nicer when
-- the empty case takes less horizontal space than the non-empty case.
ø :: Monoid a => a
ø :: forall a. Monoid a => a
ø = forall a. Monoid a => a
mempty

makeNote :: a -> S.Sequence g a
makeNote :: forall a g. a -> Sequence g a
makeNote a
a = forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. a -> Note g a
S.Note a
a

-- * realize

writeHtml :: FilePath -> Korvai -> IO ()
writeHtml :: FilePath -> Korvai -> IO ()
writeHtml FilePath
fname = FilePath -> Score -> IO ()
Html.writeAll FilePath
fname forall b c a. (b -> c) -> (a -> b) -> a -> c
• Korvai -> Score
Korvai.Single

-- * notation

-- | Make a single sollu 'Solkattu.Karvai'.
karvai :: (CallStack.Stack, Pretty sollu) => SequenceT sollu -> SequenceT sollu
karvai :: forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu
karvai = forall sollu.
(Stack, Pretty sollu) =>
(Note sollu -> Note sollu) -> SequenceT sollu -> SequenceT sollu
modifySingleNote forall a b. (a -> b) -> a -> b
$ forall a b. (NoteT a -> NoteT b) -> Note a -> Note b
Solkattu.modifyNote forall a b. (a -> b) -> a -> b
$
    \NoteT sollu
note -> NoteT sollu
note { _karvai :: Bool
Solkattu._karvai = Bool
True }

-- * check alignment

akshara :: Akshara -> SequenceT sollu
akshara :: forall sollu. Int -> SequenceT sollu
akshara Int
n = forall a g. a -> Sequence g a
makeNote (forall sollu. Int -> Note sollu
Solkattu.Alignment Int
n)

-- | Assert that the following sollu is on sam.
sam :: SequenceT sollu
sam :: forall sollu. SequenceT sollu
sam = forall sollu. Int -> SequenceT sollu
akshara Int
0

-- | Align at the given akshara.  I use § because I don't use it so often,
-- and it's opt-6 on OS X.
(§) :: SequenceT sollu -> Akshara -> SequenceT sollu
SequenceT sollu
seq § :: forall sollu. SequenceT sollu -> Int -> SequenceT sollu
§ Int
n = forall a g. a -> Sequence g a
makeNote (forall sollu. Int -> Note sollu
Solkattu.Alignment Int
n) forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
seq
infix 9 §

-- * modify sollus

modifySingleNote :: (CallStack.Stack, Pretty sollu) =>
    (Solkattu.Note sollu -> Solkattu.Note sollu)
    -> SequenceT sollu -> SequenceT sollu
modifySingleNote :: forall sollu.
(Stack, Pretty sollu) =>
(Note sollu -> Note sollu) -> SequenceT sollu -> SequenceT sollu
modifySingleNote Note sollu -> Note sollu
modify = forall g1 a1 g2 a2.
([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
S.apply [Note Group (Note sollu)] -> [Note Group (Note sollu)]
go
    where
    go :: [Note Group (Note sollu)] -> [Note Group (Note sollu)]
go = \case
        Note Group (Note sollu)
n : [Note Group (Note sollu)]
ns -> case Note Group (Note sollu)
n of
            S.Note note :: Note sollu
note@(Solkattu.Note {}) -> forall g a. a -> Note g a
S.Note (Note sollu -> Note sollu
modify Note sollu
note) forall a. a -> [a] -> [a]
: [Note Group (Note sollu)]
ns
            S.TempoChange TempoChange
change [Note Group (Note sollu)]
sub -> forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange TempoChange
change ([Note Group (Note sollu)] -> [Note Group (Note sollu)]
go [Note Group (Note sollu)]
sub) forall a. a -> [a] -> [a]
: [Note Group (Note sollu)]
ns
            Note Group (Note sollu)
_ -> forall a. Stack => Text -> a
throw forall a b. (a -> b) -> a -> b
$ Text
"expected a single note: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Note Group (Note sollu)
n
        [] -> forall a. Stack => Text -> a
throw Text
"expected a single note, but got []"

stripRests :: SequenceT sollu -> SequenceT sollu
stripRests :: forall sollu. SequenceT sollu -> SequenceT sollu
stripRests = forall a g. (a -> Bool) -> Sequence g a -> Sequence g a
S.filterNotes forall {sollu}. Note sollu -> Bool
notRest
    where
    notRest :: Note sollu -> Bool
notRest (Solkattu.Space {}) = Bool
False
    notRest Note sollu
_ = Bool
True

-- ** strokes

lt, hv :: SequenceT (Realize.Stroke stroke) -> SequenceT (Realize.Stroke stroke)
lt :: forall stroke.
SequenceT (Stroke stroke) -> SequenceT (Stroke stroke)
lt = forall sollu.
(sollu -> sollu) -> SequenceT sollu -> SequenceT sollu
mapSollu (\Stroke stroke
stroke -> Stroke stroke
stroke { _emphasis :: Emphasis
Realize._emphasis = Emphasis
Realize.Light })
hv :: forall stroke.
SequenceT (Stroke stroke) -> SequenceT (Stroke stroke)
hv = forall sollu.
(sollu -> sollu) -> SequenceT sollu -> SequenceT sollu
mapSollu (\Stroke stroke
stroke -> Stroke stroke
stroke { _emphasis :: Emphasis
Realize._emphasis = Emphasis
Realize.Heavy })

mapSollu :: (sollu -> sollu) -> SequenceT sollu -> SequenceT sollu
mapSollu :: forall sollu.
(sollu -> sollu) -> SequenceT sollu -> SequenceT sollu
mapSollu = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
• forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- * Config

wider :: Terminal.Config -> Terminal.Config
wider :: Config -> Config
wider Config
config =
    Config
config { _terminalWidth :: Int
Terminal._terminalWidth = Config -> Int
Terminal._terminalWidth Config
config forall a. Num a => a -> a -> a
+ Int
40 }

abstract :: Abstraction -> Terminal.Config -> Terminal.Config
abstract :: Abstraction -> Config -> Config
abstract Abstraction
a Config
config = Config
config { _abstraction :: Abstraction
Terminal._abstraction = Abstraction
a }

concrete :: Terminal.Config -> Terminal.Config
concrete :: Config -> Config
concrete = Abstraction -> Config -> Config
abstract forall a. Monoid a => a
mempty

-- | Abstract all Patterns to durations.
patterns :: Abstraction
patterns :: Abstraction
patterns = GroupType -> Abstraction
Format.abstract GroupType
Solkattu.GPattern

namedGroups :: Abstraction
namedGroups :: Abstraction
namedGroups = GroupType -> Abstraction
Format.named GroupType
Solkattu.GGroup

allAbstract :: Abstraction
allAbstract :: Abstraction
allAbstract = Abstraction
Format.allAbstract

-- * patterns

pat :: Matra -> SequenceT sollu
pat :: forall sollu. Int -> SequenceT sollu
pat Int
d = forall a g. a -> Sequence g a
makeNote forall a b. (a -> b) -> a -> b
$ forall sollu. Pattern -> Note sollu
Solkattu.Pattern (Int -> Pattern
Solkattu.pattern Int
d)

p5, p6, p7, p8, p9 :: SequenceT sollu
p5 :: forall sollu. SequenceT sollu
p5 = forall sollu. Int -> SequenceT sollu
pat Int
5
p6 :: forall sollu. SequenceT sollu
p6 = forall sollu. Int -> SequenceT sollu
pat Int
6
p7 :: forall sollu. SequenceT sollu
p7 = forall sollu. Int -> SequenceT sollu
pat Int
7
p8 :: forall sollu. SequenceT sollu
p8 = forall sollu. Int -> SequenceT sollu
pat Int
8
p9 :: forall sollu. SequenceT sollu
p9 = forall sollu. Int -> SequenceT sollu
pat Int
9

p666, p567, p765 :: SequenceT sollu -> SequenceT sollu
p666 :: forall sollu. SequenceT sollu -> SequenceT sollu
p666 SequenceT sollu
sep = forall sollu.
SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
trin SequenceT sollu
sep (forall sollu. Int -> SequenceT sollu
pat Int
6) (forall sollu. Int -> SequenceT sollu
pat Int
6) (forall sollu. Int -> SequenceT sollu
pat Int
6)
p567 :: forall sollu. SequenceT sollu -> SequenceT sollu
p567 SequenceT sollu
sep = forall sollu.
SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
trin SequenceT sollu
sep (forall sollu. Int -> SequenceT sollu
pat Int
5) (forall sollu. Int -> SequenceT sollu
pat Int
6) (forall sollu. Int -> SequenceT sollu
pat Int
7)
p765 :: forall sollu. SequenceT sollu -> SequenceT sollu
p765 SequenceT sollu
sep = forall sollu.
SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
trin SequenceT sollu
sep (forall sollu. Int -> SequenceT sollu
pat Int
7) (forall sollu. Int -> SequenceT sollu
pat Int
6) (forall sollu. Int -> SequenceT sollu
pat Int
5)


-- * talam

-- | For a fragment which fits a certain number of beats.
beats :: Akshara -> Tala.Tala
beats :: Int -> Tala
beats = Int -> Tala
Tala.beats

adi :: Tala.Tala
adi :: Tala
adi = Tala
Tala.adi_tala

-- * conveniences

ganesh, janahan, sudhindra :: Korvai -> Korvai
ganesh :: Korvai -> Korvai
ganesh = Text -> Korvai -> Korvai
source Text
"ganesh"
janahan :: Korvai -> Korvai
janahan = Text -> Korvai -> Korvai
source Text
"janahan"
sudhindra :: Korvai -> Korvai
sudhindra = Text -> Korvai -> Korvai
source Text
"sudhindra"

elaforge :: Korvai -> Korvai
elaforge :: Korvai -> Korvai
elaforge = Text -> Korvai -> Korvai
source Text
"elaforge"