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

-- | Extract Korvai definitions into a list in a generated module.
module Solkattu.ExtractKorvais where
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified System.Environment

import qualified Util.ExtractHs as ExtractHs
import qualified Util.Texts as Texts
import Global


main :: IO ()
main :: IO ()
main = do
    [String]
args <- IO [String]
System.Environment.getArgs
    forall a.
[String]
-> (Text -> a)
-> (String -> Map String a -> Either Text ([Text], Text))
-> IO ()
ExtractHs.process [String]
args
        ([(Int, (Text, Text))] -> [(Type, (Int, Text))]
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Int, (Text, Text))]
ExtractHs.typeDeclarations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
ExtractHs.stripComments)
        String
-> Map String [(Type, (Int, Text))] -> Either Text ([Text], Text)
generate

data Type = Korvai | Score deriving (Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

-- | Extract "something :: Korvai" lines.
extract :: [(Int, (Text, Text))] -> [(Type, (Int, Text))]
    -- ^ (lineno, variableName)
extract :: [(Int, (Text, Text))] -> [(Type, (Int, Text))]
extract = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a -> b) -> a -> b
$ \(Int
lineno, (Text
variable, Text
type_)) ->
    (, (Int
lineno, Text
variable)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text
type_ of
        Text
"Korvai" -> forall a. a -> Maybe a
Just Type
Korvai
        Text
"Score" -> forall a. a -> Maybe a
Just Type
Score
        Text
_ -> forall a. Maybe a
Nothing

generate :: FilePath -> Map FilePath [(Type, (Int, Text))]
    -> Either ExtractHs.Error ([ExtractHs.Warning], Text)
generate :: String
-> Map String [(Type, (Int, Text))] -> Either Text ([Text], Text)
generate String
outFname Map String [(Type, (Int, Text))]
extracted = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text]
warnings,) forall a b. (a -> b) -> a -> b
$
    Text -> Map Text Text -> Either Text Text
Texts.interpolate Text
template forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Text
"module", String -> Text
ExtractHs.moduleDeclaration String
outFname)
        , (Text
"imports", [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map String -> Text
ExtractHs.makeImport (forall k a. Map k a -> [k]
Map.keys Map String [(Type, (Int, Text))]
fnameDefs))
        , (Text
"scores", Text -> [Text] -> Text
Text.intercalate Text
"\n    , "
            [ String -> (Int, Text) -> Type -> Text
scoreDef String
fname (Int, Text)
def Type
type_
            | (String
fname, [(Type, (Int, Text))]
defs) <- forall k a. Map k a -> [(k, a)]
Map.toList Map String [(Type, (Int, Text))]
fnameDefs, (Type
type_, (Int, Text)
def) <- [(Type, (Int, Text))]
defs
            ])
        ]
    where
    (Map String [(Type, (Int, Text))]
empty, Map String [(Type, (Int, Text))]
fnameDefs) = forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String [(Type, (Int, Text))]
extracted
    warnings :: [Text]
warnings = forall a b. (a -> b) -> [a] -> [b]
map ((Text
"Warning: no korvai defs in " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
txt) (forall k a. Map k a -> [k]
Map.keys Map String [(Type, (Int, Text))]
empty)

scoreDef :: FilePath -> (Int, Text) -> Type -> Text
scoreDef :: String -> (Int, Text) -> Type -> Text
scoreDef String
fname (Int
lineno, Text
variableName) Type
type_ = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"")
    [ Text
"setLocation", forall a. Show a => a -> Text
showt (Text
module_, Int
lineno, Text
variableName), Text
"$"
    , case Type
type_ of
        Type
Score -> Text
""
        Type
Korvai -> Text
"Single"
    , Text
module_ forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
variableName
    ]
    where module_ :: Text
module_ = String -> Text
ExtractHs.pathToModule String
fname

template :: Text
template :: Text
template =
    Text
"-- | Collect korvais into one database.\n\
    \-- This is automatically generated, but checked in for convenience.\n\
    \-- Don't edit it directly.  Any modifications to the the source\n\
    \-- directory should cause it to be regenerated.\n\
    \${module}\n\
    \import qualified Solkattu.Korvai as Korvai\n\
    \import           Solkattu.Korvai (Score(Single), setLocation)\n\
    \${imports}\n\
    \\n\
    \scores :: [Korvai.Score]\n\
    \scores = map Korvai.inferMetadataS\n\
    \    [ ${scores}\n\
    \    ]\n"