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

-- | Functions to deal with 'Korvai.Metadata'.  The type itself has to be
-- defined in "Solkattu.Korvai" to avoid a circular import.
module Solkattu.Metadata where
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Time.Calendar as Calendar

import qualified Util.CallStack as CallStack
import qualified Util.Lists as Lists
import qualified Util.Num as Num
import qualified Util.Parse as Parse
import qualified Util.Regex as Regex

import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Solkattu as Solkattu
import qualified Solkattu.Tags as Tags

import           Global


-- * query

scoreTag :: Text -> Korvai.Score -> [Text]
scoreTag :: Text -> Score -> [Text]
scoreTag Text
tag = Text -> Metadata -> [Text]
getTag Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Metadata
Korvai.scoreMetadata

-- | Get a korvai tag's values.
getTag :: Text -> Korvai.Metadata -> [Text]
getTag :: Text -> Metadata -> [Text]
getTag Text
tag = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> Map Text [Text]
Tags.untags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Tags
Korvai._tags

scoreLocation :: Korvai.Score -> Korvai.Location
scoreLocation :: Score -> Location
scoreLocation = Metadata -> Location
Korvai._location forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Metadata
Korvai.scoreMetadata

korvaiLocation :: Korvai.Korvai -> Korvai.Location
korvaiLocation :: Korvai -> Location
korvaiLocation = Metadata -> Location
Korvai._location forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Metadata
Korvai.korvaiMetadata

showLocation :: Korvai.Location -> Text
showLocation :: Location -> Text
showLocation (Text
module_, Int
line, Text
name) =
    Text
path forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
line forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
name
    where path :: Text
path = HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"." Text
"/" Text
module_ forall a. Semigroup a => a -> a -> a
<> Text
".hs"

moduleVariable :: Korvai.Score -> Text
moduleVariable :: Score -> Text
moduleVariable Score
score = forall a. [a] -> a
last (HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"." Text
module_) forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
name
    where (Text
module_, Int
_, Text
name) = Score -> Location
scoreLocation Score
score

-- * date

makeDate :: CallStack.Stack => Int -> Int -> Int -> Calendar.Day
makeDate :: HasCallStack => Int -> Int -> Int -> Day
makeDate Int
y Int
m Int
d = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => Text -> a
Solkattu.throw forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Either Text Day
checkDate Int
y Int
m Int
d

checkDate :: Int -> Int -> Int -> Either Text Calendar.Day
checkDate :: Int -> Int -> Int -> Either Text Day
checkDate Int
y Int
m Int
d
    | forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
2012 Int
2030 Int
y Bool -> Bool -> Bool
&& forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
1 Int
13 Int
m Bool -> Bool -> Bool
&& forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
1 Int
32 Int
d =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
Calendar.fromGregorian (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int
m Int
d
    | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"invalid date: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (Int
y, Int
m, Int
d)

-- * time

-- | (hour, minute, second)
type Time = (Int, Int, Int)

showRecording :: CallStack.Stack => Text -> Maybe (Time, Maybe Time) -> Text
showRecording :: HasCallStack =>
Text -> Maybe ((Int, Int, Int), Maybe (Int, Int, Int)) -> Text
showRecording Text
url Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
maybeRange = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ Text
url forall a. a -> [a] -> [a]
: case Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
maybeRange of
    Maybe ((Int, Int, Int), Maybe (Int, Int, Int))
Nothing -> []
    Just ((Int, Int, Int)
start, Maybe (Int, Int, Int)
end) -> HasCallStack => (Int, Int, Int) -> Text
showTime (Int, Int, Int)
start forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => (Int, Int, Int) -> Text
showTime) Maybe (Int, Int, Int)
end
    -- TODO could recognize youtube urls and append the ?t=123


parseRecording :: Text -> Maybe (Text, Maybe (Time, Time))
parseRecording :: Text -> Maybe (Text, Maybe ((Int, Int, Int), (Int, Int, Int)))
parseRecording Text
s = case Text -> [Text]
Text.words Text
s of
    Text
url : [Text]
range -> (Text
url,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe (Maybe ((Int, Int, Int), (Int, Int, Int)))
parseRange [Text]
range
    [Text]
_ -> forall a. Maybe a
Nothing
    where
    parseRange :: [Text] -> Maybe (Maybe ((Int, Int, Int), (Int, Int, Int)))
parseRange [] = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
    parseRange [Text
start, Text
end] = do
        (Int, Int, Int)
start <- Text -> Maybe (Int, Int, Int)
parseTime Text
start
        (Int, Int, Int)
end <- Text -> Maybe (Int, Int, Int)
parseTime Text
end
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ((Int, Int, Int)
start, (Int, Int, Int)
end)
    parseRange [Text]
_ = forall a. Maybe a
Nothing

parseTime :: Text -> Maybe Time
parseTime :: Text -> Maybe (Int, Int, Int)
parseTime Text
s = case Regex -> Text -> [(Text, [Text])]
Regex.groups Regex
time Text
s of
    (Text
_, [Text]
groups) : [(Text, [Text])]
_ -> forall a. a -> Maybe a
Just (Text -> Int
parse Text
h, Text -> Int
parse Text
m, Text -> Int
parse Text
s)
        where Text
h : Text
m : Text
s : [Text]
_ = [Text]
groups forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Text
""
    [(Text, [Text])]
_ -> forall a. Maybe a
Nothing
    where
    Right Regex
time = String -> Either String Regex
Regex.compile String
"(\\d+h)?(\\d+m)?(\\d+s)?"
    parse :: Text -> Int
    parse :: Text -> Int
parse = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Maybe a
Parse.parse_maybe forall (m :: * -> *). ParserT m Int
Parse.p_nat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.dropEnd Int
1

showTime :: CallStack.Stack => Time -> Text
showTime :: HasCallStack => (Int, Int, Int) -> Text
showTime (Int
h, Int
m, Int
s)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
<Int
0) [Int
h, Int
m, Int
s] Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
>=Int
60) [Int
m, Int
s] =
        forall a. HasCallStack => Text -> a
Solkattu.throw forall a b. (a -> b) -> a -> b
$ Text
"invalid time: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (Int
h, Int
m, Int
s)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Int
0) [Int
h, Int
m, Int
s] = Text
"0s"
    | Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [forall a. Show a => a -> Text
showt Int
h forall a. Semigroup a => a -> a -> a
<> Text
"h" | Int
h forall a. Ord a => a -> a -> Bool
> Int
0]
        , [forall a. Show a => a -> Text
showt Int
m forall a. Semigroup a => a -> a -> a
<> Text
"m" | Int
m forall a. Ord a => a -> a -> Bool
> Int
0]
        , [forall a. Show a => a -> Text
showt Int
s forall a. Semigroup a => a -> a -> a
<> Text
"s" | Int
s forall a. Ord a => a -> a -> Bool
> Int
0]
        ]

-- * sections

-- | Get a section tag's values, concatenated and uniqued.
sectionTag :: Text -> Korvai.Score -> [Text]
sectionTag :: Text -> Score -> [Text]
sectionTag Text
tag = forall a. Ord a => [a] -> [a]
Lists.unique
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> Map Text [Text]
Tags.untags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Tags]
sectionTags

sectionTags :: Korvai.Score -> [Tags.Tags]
sectionTags :: Score -> [Tags]
sectionTags = forall a b. (a -> b) -> [a] -> [b]
map forall a. Section a -> Tags
Korvai.sectionTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Section ()]
Korvai.scoreSections