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

-- | DSL functions to add metadata to Korvais.
module Solkattu.Dsl.Metadata (
    comment, date, source, similarTo
    , recording
    , korvaiT, koraippu, mohra, mohraKorvai, sarvalaghu, tirmanam, sollu
    , sequenceT, faran, exercise, trikalam
    , withType
) where
import qualified Text.Read as Read

import qualified Util.CallStack as CallStack
import qualified Util.Lists as Lists
import qualified Solkattu.Korvai as Korvai
import           Solkattu.Korvai (Korvai)
import qualified Solkattu.Metadata as Metadata
import qualified Solkattu.Tags as Tags

import           Global


-- | Attach a generic comment.
comment :: Text -> Korvai -> Korvai
comment :: Text -> Korvai -> Korvai
comment = Text -> Text -> Korvai -> Korvai
withTag Text
Tags.comment

date :: CallStack.Stack => Int -> Int -> Int -> Korvai -> Korvai
date :: HasCallStack => Int -> Int -> Int -> Korvai -> Korvai
date Int
y Int
m Int
d = Metadata -> Korvai -> Korvai
Korvai.withKorvaiMetadata forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { _date :: Maybe Day
Korvai._date = forall a. a -> Maybe a
Just Day
date }
    where !date :: Day
date = HasCallStack => Int -> Int -> Int -> Day
Metadata.makeDate Int
y Int
m Int
d

-- | Where or from who I learned it.
source :: Text -> Korvai -> Korvai
source :: Text -> Korvai -> Korvai
source = Text -> Text -> Korvai -> Korvai
withTag Text
Tags.source

-- | This could be considered a variant of the other.  Takes "Module"
-- "variableName", since the location is added later in "Solkattu.All".
-- The link is verified in Db_test.
similarTo :: Text -> Text -> Korvai -> Korvai
similarTo :: Text -> Text -> Korvai -> Korvai
similarTo Text
module_ Text
variableName =
    Text -> Text -> Korvai -> Korvai
withTag Text
Tags.similarTo (Text
module_ forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
variableName)

-- | A recording where the clip is played.
recording :: CallStack.Stack => Text -- ^ URL to the recording or video
    -> String -- ^ start and end time of the clip within the recording
    -> Korvai -> Korvai
recording :: HasCallStack => Text -> NonNull Char -> Korvai -> Korvai
recording Text
url NonNull Char
range = Text -> Text -> Korvai -> Korvai
withTag Text
Tags.recording forall a b. (a -> b) -> a -> b
$
    HasCallStack =>
Text -> Maybe ((Int, Int, Int), Maybe (Int, Int, Int)) -> Text
Metadata.showRecording Text
url forall a b. (a -> b) -> a -> b
$ NonNull Char -> Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
parseRange NonNull Char
range
    -- showRecording will turn it right back into a string, but by parsing here
    -- it gets validated.

parseRange :: String -> Maybe (Metadata.Time, Maybe Metadata.Time)
parseRange :: NonNull Char -> Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
parseRange NonNull Char
"" = forall a. Maybe a
Nothing
parseRange NonNull Char
str = case Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
range of
    Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
Nothing -> forall a. HasCallStack => NonNull Char -> a
error forall a b. (a -> b) -> a -> b
$ NonNull Char
"no parse for time range: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> NonNull Char
show NonNull Char
str
    Just ((Int, Int, Int)
start, Just (Int, Int, Int)
end) | (Int, Int, Int)
end forall a. Ord a => a -> a -> Bool
<= (Int, Int, Int)
start ->
        forall a. HasCallStack => NonNull Char -> a
error forall a b. (a -> b) -> a -> b
$ NonNull Char
"end before start: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> NonNull Char
show ((Int, Int, Int)
start, (Int, Int, Int)
end)
    Just ((Int, Int, Int)
start, Maybe (Int, Int, Int)
end) -> forall a. a -> Maybe a
Just ((Int, Int, Int)
start, Maybe (Int, Int, Int)
end)
    where
    range :: Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
range = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonNull Char -> Maybe (Int, Int, Int)
parseTime NonNull Char
start
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if NonNull Char
end forall a. Eq a => a -> a -> Bool
== NonNull Char
"" then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonNull Char -> Maybe (Int, Int, Int)
parseTime NonNull Char
end)
    (NonNull Char
start, NonNull Char
end) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'-')) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'-') NonNull Char
str

parseTime :: String -> Maybe (Int, Int, Int)
parseTime :: NonNull Char -> Maybe (Int, Int, Int)
parseTime NonNull Char
str = case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Read a => NonNull Char -> Maybe a
Read.readMaybe forall a b. (a -> b) -> a -> b
$ forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split NonNull Char
":" NonNull Char
str of
    Just [Int
h, Int
m, Int
s] -> forall a. a -> Maybe a
Just (Int
h, Int
m, Int
s)
    Just [Int
m, Int
s] -> forall a. a -> Maybe a
Just (Int
0, Int
m, Int
s)
    Just [Int
s] -> forall a. a -> Maybe a
Just (Int
0, Int
0, Int
s)
    Maybe [Int]
_ -> forall a. Maybe a
Nothing

-- * types

korvaiT :: Korvai -> Korvai
korvaiT :: Korvai -> Korvai
korvaiT = Text -> Korvai -> Korvai
withType Text
"korvai"

koraippu :: Korvai -> Korvai
koraippu :: Korvai -> Korvai
koraippu = Text -> Korvai -> Korvai
withType Text
"koraippu"

mohra :: Korvai -> Korvai
mohra :: Korvai -> Korvai
mohra = Text -> Korvai -> Korvai
withType Text
"mohra"

mohraKorvai :: Korvai -> Korvai
mohraKorvai :: Korvai -> Korvai
mohraKorvai = Text -> Korvai -> Korvai
withType Text
"mohra-korvai"

sarvalaghu :: Korvai -> Korvai
sarvalaghu :: Korvai -> Korvai
sarvalaghu = Text -> Korvai -> Korvai
withType Text
"sarvalaghu"

-- | A short cadence, suitable to end a phrase or section.
tirmanam :: Korvai -> Korvai
tirmanam :: Korvai -> Korvai
tirmanam = Text -> Korvai -> Korvai
withType Text
"tirmanam"

-- | Shorter than a tirmanam and usually not having structure, just a fill.
sollu :: Korvai -> Korvai
sollu :: Korvai -> Korvai
sollu = Text -> Korvai -> Korvai
withType Text
"sollu"

-- | A development sequence, possibly leading to a korvai.
sequenceT :: Korvai -> Korvai
sequenceT :: Korvai -> Korvai
sequenceT = Text -> Korvai -> Korvai
withType Text
"sequence"

faran :: Korvai -> Korvai
faran :: Korvai -> Korvai
faran = Text -> Korvai -> Korvai
withType Text
"faran"

exercise :: Korvai -> Korvai
exercise :: Korvai -> Korvai
exercise =
    Text -> Text -> Korvai -> Korvai
replaceSectionTags Text
Tags.type_ Text
Tags.exercise forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Korvai -> Korvai
withType Text
Tags.exercise
    -- Replace the inferred development and ending types, exercises generally
    -- don't have those things.

trikalam :: Korvai -> Korvai
trikalam :: Korvai -> Korvai
trikalam = Text -> Korvai -> Korvai
withType Text
"trikalam"

withType :: Text -> Korvai -> Korvai
withType :: Text -> Korvai -> Korvai
withType = Text -> Text -> Korvai -> Korvai
withTag Text
Tags.type_

-- * util

withTag :: Text -> Text -> Korvai -> Korvai
withTag :: Text -> Text -> Korvai -> Korvai
withTag Text
k Text
v = Metadata -> Korvai -> Korvai
Korvai.withKorvaiMetadata forall a b. (a -> b) -> a -> b
$
    forall a. Monoid a => a
mempty { _tags :: Tags
Korvai._tags = Text -> Text -> Tags
Tags.tag Text
k Text
v }

replaceSectionTags :: Text -> Text -> Korvai -> Korvai
replaceSectionTags :: Text -> Text -> Korvai -> Korvai
replaceSectionTags Text
k Text
v = (Tags -> Tags) -> Korvai -> Korvai
Korvai.modifySections forall a b. (a -> b) -> a -> b
$ Text -> Text -> Tags -> Tags
Tags.replace Text
k Text
v