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

{-# LANGUAGE DeriveGeneric #-}
-- | Utilities to randomly select things to practice, and save what
-- I practiced, for a flashcard-esque system.
module Solkattu.Practice where
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Time as Time

import qualified GHC.Generics as Generics
import qualified System.Random as Random

import qualified Util.Lists as Lists
import qualified Util.Texts as Texts
import qualified Solkattu.Db as Db
import qualified Solkattu.Format.Format as Format
import qualified Solkattu.Format.Terminal as Terminal
import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Metadata as Metadata

import           Global


-- | The number of date groups starting from the most recent.
recentDates :: Int -> IO ()
recentDates :: BPM -> IO ()
recentDates BPM
n =
    Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ [(BPM, Score)] -> Text
Db.formats forall a b. (a -> b) -> a -> b
$ Select -> [Score -> Bool] -> [(BPM, Score)]
Db.searchAll (BPM -> Select
Db.recentDates BPM
n) []

searchName :: Text -> IO ()
searchName :: Text -> IO ()
searchName Text
name = [Score -> Bool] -> IO ()
Db.searchp [Text -> Score -> Bool
Db.nameLike Text
name]

types :: [Text]
types :: [Text]
types = [Text
"exercise", Text
"korvai"]

-- | Pick a random korvai with any of the given types.
randomTypes :: [Text] -> IO ()
randomTypes :: [Text] -> IO ()
randomTypes [Text]
types = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
types forall a b. (a -> b) -> a -> b
$ \Text
typ -> do
        Maybe (BPM, Score)
score <- forall a. [a] -> IO (Maybe a)
pick forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Score -> Bool
Db.ofType Text
typ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(BPM, Score)]
Db.scores
        Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
typ forall a. Semigroup a => a -> a -> a
<> Text
":"
        Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Nothing" (BPM, Score) -> Text
Db.format Maybe (BPM, Score)
score

realize, realizep :: Int -> IO ()
realize :: BPM -> IO ()
realize BPM
i = do
    let score :: Score
score = BPM -> Score
get BPM
i
    Text -> IO ()
Text.IO.putStr forall a b. (a -> b) -> a -> b
$ (BPM, Score) -> Text
Db.format (BPM
i, Score
score)
    Abstraction -> Score -> IO ()
realizeM forall a. Monoid a => a
mempty Score
score
realizep :: BPM -> IO ()
realizep BPM
i = do
    let score :: Score
score = BPM -> Score
get BPM
i
    Text -> IO ()
Text.IO.putStr forall a b. (a -> b) -> a -> b
$ (BPM, Score) -> Text
Db.format (BPM
i, Score
score)
    Abstraction -> Score -> IO ()
realizeM Abstraction
Format.defaultAbstraction Score
score

realizeM :: Format.Abstraction -> Korvai.Score -> IO ()
realizeM :: Abstraction -> Score -> IO ()
realizeM Abstraction
abstraction = (Korvai -> IO ()) -> Score -> IO ()
Korvai.realizeScore forall a b. (a -> b) -> a -> b
$
    forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Abstraction -> Korvai -> IO ()
Terminal.printInstrument Instrument Stroke
Korvai.IMridangam Abstraction
abstraction

realizeKon :: Int -> IO ()
realizeKon :: BPM -> IO ()
realizeKon BPM
i =
    (Korvai -> IO ()) -> Score -> IO ()
Korvai.realizeScore (Config -> Korvai -> IO ()
Terminal.printKonnakol Config
Terminal.konnakolConfig) (BPM -> Score
get BPM
i)

-- | Mark these korvais as practiced.  Using the index is awkward because it's
-- the same type as BPM.
practiced :: Int -> BPM -> IO ()
practiced :: BPM -> BPM -> IO ()
practiced BPM
index BPM
bpm = Text -> BPM -> IO ()
practicedName Text
name BPM
bpm
    where name :: Text
name = Score -> Text
Db.qualifiedName forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(BPM, Score)]
Db.scores forall a. [a] -> BPM -> a
!! BPM
index

practicedName :: Text -> BPM -> IO ()
practicedName :: Text -> BPM -> IO ()
practicedName Text
name BPM
bpm = do
    UTCTime
now <- IO UTCTime
Time.getCurrentTime
    case [Score -> Bool] -> [(BPM, Score)]
Db.search [Text -> Score -> Bool
Db.nameLike Text
name] of
        [(BPM
_, Score
score)] -> [Practiced] -> IO ()
savePracticed
            [Text -> UTCTime -> Maybe BPM -> Practiced
Practiced (Score -> Text
Db.qualifiedName Score
score) UTCTime
now (forall a. a -> Maybe a
Just BPM
bpm)]
        [] -> Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"no score named like " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
name
        [(BPM, Score)]
scores -> Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"multiple scores that match:\n"
            forall a. Semigroup a => a -> a -> a
<> [(BPM, Score)] -> Text
Db.formats [(BPM, Score)]
scores

type BPM = Int

get :: Int -> Korvai.Score
get :: BPM -> Score
get = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(BPM, Score)]
Db.scores !!)

-- * practiced db

practicedDb :: FilePath
practicedDb :: String
practicedDb = String
"data/practiced.json"

pick :: [a] -> IO (Maybe a)
pick :: forall a. [a] -> IO (Maybe a)
pick [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
pick [a]
ks = do
    BPM
i <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
Random.randomRIO (BPM
0, forall (t :: * -> *) a. Foldable t => t a -> BPM
length [a]
ks forall a. Num a => a -> a -> a
- BPM
1)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [a]
ks forall a. [a] -> BPM -> a
!! BPM
i

data Practiced = Practiced {
    Practiced -> Text
name :: Text
    , Practiced -> UTCTime
date :: Time.UTCTime
    , Practiced -> Maybe BPM
bpm :: Maybe BPM
    } deriving (Practiced -> Practiced -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Practiced -> Practiced -> Bool
$c/= :: Practiced -> Practiced -> Bool
== :: Practiced -> Practiced -> Bool
$c== :: Practiced -> Practiced -> Bool
Eq, BPM -> Practiced -> ShowS
[Practiced] -> ShowS
Practiced -> String
forall a.
(BPM -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Practiced] -> ShowS
$cshowList :: [Practiced] -> ShowS
show :: Practiced -> String
$cshow :: Practiced -> String
showsPrec :: BPM -> Practiced -> ShowS
$cshowsPrec :: BPM -> Practiced -> ShowS
Show, forall x. Rep Practiced x -> Practiced
forall x. Practiced -> Rep Practiced x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Practiced x -> Practiced
$cfrom :: forall x. Practiced -> Rep Practiced x
Generics.Generic)
instance Aeson.ToJSON Practiced
instance Aeson.FromJSON Practiced

savePracticed :: [Practiced] -> IO ()
savePracticed :: [Practiced] -> IO ()
savePracticed = String -> Text -> IO ()
Text.IO.appendFile String
practicedDb forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Textlike a => a -> Text
Texts.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn Practiced -> UTCTime
date

loadPracticed :: IO [Practiced]
loadPracticed :: IO [Practiced]
loadPracticed = do
    [Text]
lines <- Text -> [Text]
Text.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
Text.IO.readFile String
practicedDb
    case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall a b. (a -> b) -> [a] -> [b]
map (forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Textlike a => a -> ByteString
Texts.toLazyByteString) [Text]
lines) of
        Left String
err -> forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ String -> Text
txt String
err
        Right [Practiced]
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return [Practiced]
ps

-- | Display practice record.
display :: IO ()
display :: IO ()
display = do
    TimeZone
tz <- IO TimeZone
Time.getCurrentTimeZone
    [(Day, [Practiced])]
by_date <- forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort (TimeZone -> UTCTime -> Day
localDay TimeZone
tz forall b c a. (b -> c) -> (a -> b) -> a -> c
. Practiced -> UTCTime
date) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Practiced]
loadPracticed
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
Text.IO.putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, [Practiced]) -> Text
pretty) [(Day, [Practiced])]
by_date
    where
    pretty :: (Day, [Practiced]) -> Text
pretty (Day
day, [Practiced]
ps) = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ (Day -> Text
prettyDay Day
day forall a. Semigroup a => a -> a -> a
<> Text
":")
        forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Practiced -> Text
prettyP) [Practiced]
ps
    prettyP :: Practiced -> Text
prettyP Practiced
p = Practiced -> Text
name Practiced
p forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"("<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>Text
")") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt) (Practiced -> Maybe BPM
bpm Practiced
p)
    prettyDay :: Day -> Text
prettyDay Day
day = forall a. Show a => a -> Text
showt Day
day forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (Day -> DayOfWeek
Time.dayOfWeek Day
day)

localDay :: Time.TimeZone -> Time.UTCTime -> Time.Day
localDay :: TimeZone -> UTCTime -> Day
localDay TimeZone
tz = LocalTime -> Day
Time.localDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
Time.utcToLocalTime TimeZone
tz