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

{-# LANGUAGE RankNTypes #-}
-- | Collect korvais into a searchable form.
module Solkattu.Db (
    module Solkattu.Db
    , module Solkattu.Dsl.Solkattu
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Monoid as Monoid
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Time.Calendar as Calendar

import qualified System.Directory as Directory
import           System.FilePath ((</>))

import qualified Util.CallStack as CallStack
import qualified Util.Files as Files
import qualified Util.Html
import qualified Util.Lists as Lists
import qualified Util.Num as Num
import qualified Util.SourceControl as SourceControl

import qualified Solkattu.All as All -- generated
import           Solkattu.Dsl.Solkattu
    (realize, realizeM, realizeR, realizek, realizekp, realizep)
import qualified Solkattu.Format.Format as Format
import qualified Solkattu.Format.Html as Html
import qualified Solkattu.Format.Terminal as Terminal
import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Metadata as Metadata
import qualified Solkattu.Tags as Tags

import           Global


scores :: [(Int, Korvai.Score)]
scores :: [(Int, Score)]
scores = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn Score -> (Maybe Day, Location)
key [Score]
All.scores)
    where
    key :: Score -> (Maybe Day, Location)
key Score
score = (Metadata -> Maybe Day
Korvai._date Metadata
m, Metadata -> Location
Korvai._location Metadata
m)
        where m :: Metadata
m = Score -> Metadata
Korvai.scoreMetadata Score
score

-- * predicates

-- | The number of date groups starting from the most recent.
recentDates :: Int -> Select
recentDates :: Int -> Select
recentDates Int
groups = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
Lists.takeEnd Int
groups
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key a. Ord key => (a -> key) -> [a] -> [[a]]
Lists.groupSort (Metadata -> Maybe Day
Korvai._date forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Metadata
Korvai.scoreMetadata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

aroundDate :: Calendar.Day -> Integer -> Korvai.Korvai -> Bool
aroundDate :: Day -> Integer -> Korvai -> Bool
aroundDate Day
date Integer
days =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Day -> Bool
inRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Maybe Day
Korvai._date forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Metadata
Korvai.korvaiMetadata
    where
    inRange :: Day -> Bool
inRange = forall a. Ord a => a -> a -> a -> Bool
Num.inRange (Integer -> Day -> Day
Calendar.addDays (-Integer
days) Day
date)
        (Integer -> Day -> Day
Calendar.addDays Integer
days Day
date)

ofType :: Text -> Korvai.Score -> Bool
ofType :: Text -> Score -> Bool
ofType Text
type_ = (Text
type_ `elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"type"

nameLike :: Text -> Korvai.Score -> Bool
nameLike :: Text -> Score -> Bool
nameLike Text
name = (Text
name `Text.isInfixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Text
qualifiedName

hasInstrument :: Text -> Korvai.Score -> Bool
hasInstrument :: Text -> Score -> Bool
hasInstrument Text
inst = (Text
inst `elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"instrument"

tagHas :: Text -> Text -> Korvai.Score -> Bool
tagHas :: Text -> Text -> Score -> Bool
tagHas Text
tag Text
val Score
score =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
val `Text.isInfixOf`) forall a b. (a -> b) -> a -> b
$
        Text -> Score -> [Text]
Metadata.scoreTag Text
tag Score
score forall a. [a] -> [a] -> [a]
++ Text -> Score -> [Text]
Metadata.sectionTag Text
tag Score
score

date :: CallStack.Stack => Int -> Int -> Int -> Calendar.Day
date :: Stack => Int -> Int -> Int -> Day
date = Stack => Int -> Int -> Int -> Day
Metadata.makeDate

-- * search

searchp :: [Korvai.Score -> Bool] -> IO ()
searchp :: [Score -> Bool] -> IO ()
searchp = Text -> IO ()
Text.IO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Score)] -> Text
formats forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Score -> Bool] -> [(Int, Score)]
search

-- | Select scores to search.  Filter can only look at one score at a time,
-- this can select a group of them.
type Select = forall i. [(i, Korvai.Score)] -> [(i, Korvai.Score)]

search :: [Korvai.Score -> Bool] -> [(Int, Korvai.Score)]
search :: [Score -> Bool] -> [(Int, Score)]
search = Select -> [Score -> Bool] -> [(Int, Score)]
searchAll forall a. a -> a
id

searchAll :: Select -> [Korvai.Score -> Bool] -> [(Int, Korvai.Score)]
searchAll :: Select -> [Score -> Bool] -> [(Int, Score)]
searchAll Select
select [Score -> Bool]
predicates = forall a. (a -> Bool) -> [a] -> [a]
filter (Score -> Bool
predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ Select
select [(Int, Score)]
scores
    where predicate :: Score -> Bool
predicate = All -> Bool
Monoid.getAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (Bool -> All
Monoid.All .) [Score -> Bool]
predicates

formats :: [(Int, Korvai.Score)] -> Text
formats :: [(Int, Score)] -> Text
formats = Text -> Text
Text.stripEnd 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 (Int, Score) -> Text
format

format :: (Int, Korvai.Score) -> Text
format :: (Int, Score) -> Text
format (Int
i, Score
score) = forall a. Monoid a => [a] -> a
mconcat
    [ forall a. Show a => a -> Text
showt Int
i, Text
": "
    , Score -> Text
qualifiedName Score
score, Text
" -- " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"no date" forall a. Show a => a -> Text
showt Maybe Day
date, Text
"\n"
    , Text
tagsText
    ]
    where
    tagsText :: Text
tagsText = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text
"    "<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text] -> Text
Text.intercalate Text
"; ") forall a b. (a -> b) -> a -> b
$
        forall a. Int -> [a] -> [[a]]
Lists.chunked Int
3 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, [Text]
v) -> Text
k forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords [Text]
v) forall a b. (a -> b) -> a -> b
$
        forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text [Text]
tags
    Tags.Tags Map Text [Text]
tags = Metadata -> Tags
Korvai._tags Metadata
meta
    date :: Maybe Day
date = Metadata -> Maybe Day
Korvai._date Metadata
meta
    meta :: Metadata
meta = Score -> Metadata
Korvai.scoreMetadata Score
score


-- * write

writeAll :: IO ()
writeAll :: IO ()
writeAll = IO ()
writeText forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
writeHtml

writeHtml :: IO ()
writeHtml :: IO ()
writeHtml = FilePath -> IO ()
writeHtmlTo FilePath
"data/solkattu-html"

writeHtml1 :: Korvai.Score -> IO ()
writeHtml1 :: Score -> IO ()
writeHtml1 Score
score = do
    let fname :: FilePath
fname = Score -> FilePath
scoreFname Score
score forall a. Semigroup a => a -> a -> a
<> FilePath
".html"
    FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"write " forall a. Semigroup a => a -> a -> a
<> FilePath
fname
    FilePath -> Score -> IO ()
Html.writeAll FilePath
fname Score
score

-- | Write all Korvais as HTML into the given directory.
writeHtmlTo :: FilePath -> IO ()
writeHtmlTo :: FilePath -> IO ()
writeHtmlTo FilePath
dir = do
    FilePath -> IO ()
clearDir FilePath
dir
    (Score -> IO ()) -> [Score] -> IO ()
writeWithStatus Score -> IO ()
write1 [Score]
All.scores
    FilePath -> Text -> IO ()
Text.IO.writeFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"index.html") forall a b. (a -> b) -> a -> b
$
        Html -> Text
Util.Html.un_html forall a b. (a -> b) -> a -> b
$ (Score -> FilePath) -> [Score] -> Html
Html.indexHtml ((forall a. Semigroup a => a -> a -> a
<>FilePath
".html") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> FilePath
scoreFname) [Score]
All.scores
    FilePath -> IO ()
writeCommit FilePath
dir
    where
    write1 :: Score -> IO ()
write1 Score
score = FilePath -> Score -> IO ()
Html.writeAll (FilePath
dir FilePath -> FilePath -> FilePath
</> Score -> FilePath
scoreFname Score
score forall a. Semigroup a => a -> a -> a
<> FilePath
".html") Score
score

scoreFname :: Korvai.Score -> FilePath
scoreFname :: Score -> FilePath
scoreFname = Text -> FilePath
untxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Text
qualifiedName

qualifiedName :: Korvai.Score -> Text
qualifiedName :: Score -> Text
qualifiedName Score
score = Text
mod forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
name
    where (Text
mod, Int
_, Text
name) = Metadata -> Location
Korvai._location forall a b. (a -> b) -> a -> b
$ Score -> Metadata
Korvai.scoreMetadata Score
score


-- ** writeText

-- | Write to solkattu-text for grepping and diffing, and solkattu-color for
-- catting.
writeText :: IO ()
writeText :: IO ()
writeText = FilePath -> FilePath -> Abstraction -> IO ()
writeTextTo FilePath
"data/solkattu-text" FilePath
"data/solkattu-color"
    Abstraction
Format.defaultAbstraction

-- | The usual text dir is a git repo, so I can see what effect changes have,
-- in the same manner as App.VerifyPerformance.
writeTextTo :: FilePath -> FilePath -> Format.Abstraction -> IO ()
writeTextTo :: FilePath -> FilePath -> Abstraction -> IO ()
writeTextTo FilePath
dir FilePath
colorDir Abstraction
abstraction = do
    FilePath -> IO ()
clearDir FilePath
dir
    FilePath -> IO ()
clearDir FilePath
colorDir
    (Score -> IO ()) -> [Score] -> IO ()
writeWithStatus Score -> IO ()
write1 [Score]
All.scores
    FilePath -> IO ()
writeCommit FilePath
dir
    FilePath -> IO ()
writeCommit FilePath
colorDir
    where
    write1 :: Score -> IO ()
write1 Score
score = do
        FilePath -> [Text] -> IO ()
Files.writeLines (FilePath
colorDir FilePath -> FilePath -> FilePath
</> Score -> FilePath
scoreFname Score
score forall a. Semigroup a => a -> a -> a
<> FilePath
".txt") [Text]
lines
        FilePath -> [Text] -> IO ()
Files.writeLines (FilePath
dir FilePath -> FilePath -> FilePath
</> Score -> FilePath
scoreFname Score
score forall a. Semigroup a => a -> a -> a
<> FilePath
".txt")
            (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
stripColors [Text]
lines)
        where lines :: [Text]
lines = Abstraction -> Score -> [Text]
Terminal.renderAll Abstraction
abstraction Score
score

writeText1 :: Korvai.Score -> IO ()
writeText1 :: Score -> IO ()
writeText1 Score
score =
    FilePath -> [Text] -> IO ()
Files.writeLines (FilePath
dir FilePath -> FilePath -> FilePath
</> Score -> FilePath
scoreFname Score
score forall a. Semigroup a => a -> a -> a
<> FilePath
".txt")
        (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
stripColors [Text]
lines)
    where
    lines :: [Text]
lines = Abstraction -> Score -> [Text]
Terminal.renderAll Abstraction
Format.defaultAbstraction Score
score
    dir :: FilePath
dir = FilePath
"data/solkattu-text"

stripColors :: Text -> Text
stripColors :: Text -> Text
stripColors = Text -> Text
Text.stripEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> [a] -> [a]
Lists.mapTail (Int -> Text -> Text
Text.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'm'))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack => Text -> Text -> [Text]
Text.splitOn Text
"\ESC["

writeWithStatus :: (Korvai.Score -> IO ()) -> [Korvai.Score] -> IO ()
writeWithStatus :: (Score -> IO ()) -> [Score] -> IO ()
writeWithStatus Score -> IO ()
write [Score]
scores = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer, Score) -> IO ()
one (forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Score]
scores)
    Char -> IO ()
putChar Char
'\n'
    where
    one :: (Integer, Score) -> IO ()
one (Integer
i, Score
korvai) = do
        Text -> IO ()
Text.IO.putStr forall a b. (a -> b) -> a -> b
$ Text
"\ESC[K" forall a. Semigroup a => a -> a -> a
<> Integer -> Text
num Integer
i forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Score]
scores)
            forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
txt (Score -> FilePath
scoreFname Score
korvai) forall a. Semigroup a => a -> a -> a
<> Text
"\r"
        Score -> IO ()
write Score
korvai
    num :: Integer -> Text
num = Int -> Char -> Text -> Text
Text.justifyLeft Int
3 Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt

writeCommit :: FilePath -> IO ()
writeCommit :: FilePath -> IO ()
writeCommit FilePath
dir = do
    Entry
patch <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
txt) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO (Either FilePath Entry)
SourceControl.current FilePath
"."
    FilePath -> Text -> IO ()
Text.IO.writeFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"commit") (Entry -> Text
SourceControl._hash Entry
patch forall a. Semigroup a => a -> a -> a
<> Text
"\n")

clearDir :: FilePath -> IO ()
clearDir :: FilePath -> IO ()
clearDir = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
Directory.removeFile forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO [FilePath]
Files.list