{-# LANGUAGE OverloadedStrings #-}

module Academic (receivers) where

import           Control.Monad              ( void )
import           Data.Char                  ( isDigit )
import qualified Data.Text as T
import           Data.List                  ( intercalate )
import           Text.Parsec                ( label
                                            , many1
                                            , sepBy1
                                            , digit
                                            , char
                                            , try
                                            )

import           Discord.Types
import           Discord

import           Command.Parser
import           Command
import           Utils                      ( sendAssetChan )

receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers = (Command (ReaderT DiscordHandle IO)
 -> Message -> DiscordHandler ())
-> [Command (ReaderT DiscordHandle IO)]
-> [Message -> DiscordHandler ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand
    [ Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
textbook
    , Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
theorem
    , Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
definition
    , Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
lemma
    , Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
syllogisms
    , Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
booleans 
    ]

-- | @respondAsset m name path@ responds to the message @m@ with the file at
-- @path@, with the name overridden as @name@.
respondAsset :: (MonadDiscord m, MonadIO m) => Message -> T.Text -> FilePath -> m ()
respondAsset :: Message -> Text -> FilePath -> m ()
respondAsset Message
m Text
name FilePath
path = ChannelId -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
ChannelId -> Text -> FilePath -> m ()
sendAssetChan (Message -> ChannelId
messageChannel Message
m) Text
name FilePath
path

-- | datatype representing possible textbook asset number formats
data TextbookAssetNumber
    = TwoDotSeparated Int Int Int
    | OneDotSeparated Int Int
    | UnknownSeparation [Int]

-- | used to create the file name
instance Show TextbookAssetNumber where
    show :: TextbookAssetNumber -> FilePath
show (TwoDotSeparated Int
a Int
b Int
c) = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
padFirst ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int
a, Int
b, Int
c]
    show (OneDotSeparated Int
a Int
b) = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
padFirst ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int
a, Int
b]

instance ParsableArgument TextbookAssetNumber where
    parserForArg :: Parser TextbookAssetNumber
parserForArg = do
        [Int]
a <- ((ParsecT Text () Identity [Int]
 -> FilePath -> ParsecT Text () Identity [Int])
-> FilePath
-> ParsecT Text () Identity [Int]
-> ParsecT Text () Identity [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParsecT Text () Identity [Int]
-> FilePath -> ParsecT Text () Identity [Int]
forall s u (m :: * -> *) a.
ParsecT s u m a -> FilePath -> ParsecT s u m a
label) FilePath
"dot-separated asset number" (ParsecT Text () Identity [Int] -> ParsecT Text () Identity [Int])
-> ParsecT Text () Identity [Int] -> ParsecT Text () Identity [Int]
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity [Int] -> ParsecT Text () Identity [Int]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity [Int] -> ParsecT Text () Identity [Int])
-> ParsecT Text () Identity [Int] -> ParsecT Text () Identity [Int]
forall a b. (a -> b) -> a -> b
$
            ((FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Int
forall a. Read a => FilePath -> a
read) ([FilePath] -> [Int])
-> ParsecT Text () Identity [FilePath]
-> ParsecT Text () Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity FilePath
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [FilePath]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (ParsecT Text () Identity Char -> ParsecT Text () Identity FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
        case [Int]
a of
            (Int
x:Int
y:[]) -> TextbookAssetNumber -> Parser TextbookAssetNumber
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextbookAssetNumber -> Parser TextbookAssetNumber)
-> TextbookAssetNumber -> Parser TextbookAssetNumber
forall a b. (a -> b) -> a -> b
$ Int -> Int -> TextbookAssetNumber
OneDotSeparated Int
x Int
y
            (Int
x:Int
y:Int
z:[]) -> TextbookAssetNumber -> Parser TextbookAssetNumber
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextbookAssetNumber -> Parser TextbookAssetNumber)
-> TextbookAssetNumber -> Parser TextbookAssetNumber
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> TextbookAssetNumber
TwoDotSeparated Int
x Int
y Int
z
            [Int]
xs -> TextbookAssetNumber -> Parser TextbookAssetNumber
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextbookAssetNumber -> Parser TextbookAssetNumber)
-> TextbookAssetNumber -> Parser TextbookAssetNumber
forall a b. (a -> b) -> a -> b
$ [Int] -> TextbookAssetNumber
UnknownSeparation [Int]
xs

padFirst :: [String] -> [String]
padFirst :: [FilePath] -> [FilePath]
padFirst (FilePath
x:[FilePath]
xs) = (Int -> ShowS
padZeroes Int
2 FilePath
x)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs

padZeroes :: Int -> String -> String
padZeroes :: Int -> ShowS
padZeroes Int
newLen FilePath
digits = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
newLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
digits) Char
'0' FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
digits

-- | Theorem.
theorem :: (MonadDiscord m, MonadIO m) => Command m
theorem :: Command m
theorem = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"thm" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"theorem" ((Message -> Text -> TextbookAssetNumber -> m ()) -> Command m)
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m Text
subject TextbookAssetNumber
number -> do
    case (Text
subject :: T.Text) of
        Text
"ila" -> case TextbookAssetNumber
number of
            x :: TextbookAssetNumber
x@TwoDotSeparated{} -> do
                let path :: FilePath
path = FilePath
"ila/theorems/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                let name :: FilePath
name = TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m (Text
"Theorem " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack FilePath
name)) FilePath
path
            TextbookAssetNumber
_ ->
                Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"ILA theorems have the format: XX.YY.ZZ!"
        Text
_ -> 
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"No theorems found for subject!"

-- | Definition.
definition :: (MonadDiscord m, MonadIO m) => Command m
definition :: Command m
definition = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"def" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"definition" ((Message -> Text -> TextbookAssetNumber -> m ()) -> Command m)
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m Text
subject TextbookAssetNumber
number -> do
    case (Text
subject :: T.Text) of
        Text
"ila" -> case TextbookAssetNumber
number of
            x :: TextbookAssetNumber
x@OneDotSeparated{} -> do
                let path :: FilePath
path = FilePath
"ila/definitions/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                let name :: FilePath
name = TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m (Text
"Definition " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack FilePath
name)) FilePath
path
            TextbookAssetNumber
_ ->
                Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"ILA definitions have the format: XX.YY!"

        Text
_ ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"No definitions found for subject!"

-- | Lemma.
lemma :: (MonadDiscord m, MonadIO m) => Command m
lemma :: Command m
lemma = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"lem" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"lemma" ((Message -> Text -> TextbookAssetNumber -> m ()) -> Command m)
-> (Message -> Text -> TextbookAssetNumber -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m Text
subject TextbookAssetNumber
number -> do
    case (Text
subject :: T.Text) of
        Text
"ila" -> case TextbookAssetNumber
number of
            x :: TextbookAssetNumber
x@TwoDotSeparated{} -> do
                let path :: FilePath
path = FilePath
"ila/lemmas/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                let name :: FilePath
name = TextbookAssetNumber -> FilePath
forall a. Show a => a -> FilePath
show TextbookAssetNumber
x FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
                Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m (Text
"Lemma " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack FilePath
name)) FilePath
path
            TextbookAssetNumber
_ ->
                Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"ILA lemmas have the format: XX.YY.ZZ!"
        Text
_ ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"No lemmas found for subject!"

-- | Textbook.
textbook :: (MonadDiscord m, MonadIO m) => Command m
textbook :: Command m
textbook = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"tb" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text -> (Message -> Text -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"textbook" ((Message -> Text -> m ()) -> Command m)
-> (Message -> Text -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m Text
subject ->
    case () of
        ()
_ | Text
subject Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"i1a", Text
"inf1a"] ->
            Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m Text
"the-holy-bible-2.png" FilePath
"textbooks/i1a-textbook.pdf"

        ()
_ | Text
subject Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"calc", Text
"cap"] ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"The textbook can be found here:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                Text
"http://gen.lib.rus.ec/book/index.php?md5=13ecb7a2ed943dcb4a302080d2d8e6ea"

        ()
_ | Text
subject Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ila" ->
            Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m Text
"ila-textbook.pdf" FilePath
"textbooks/ila-textbook.pdf"

        ()
otherwse ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"No textbook registered for `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subject Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`!"

-- | Syllogisms.
syllogisms :: (MonadDiscord m, MonadIO m) => Command m
syllogisms :: Command m
syllogisms = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"syl" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text -> (Message -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"syllogisms" ((Message -> m ()) -> Command m) -> (Message -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m ->
    Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m Text
"id-smash-aristotle.png" FilePath
"cl/syllogisms.png"

-- | Booleans.
booleans :: (MonadDiscord m, MonadIO m) => Command m
booleans :: Command m
booleans = Text -> Command m -> Command m
forall (m :: * -> *). Text -> Command m -> Command m
alias Text
"bool" (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text -> (Message -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"booleans" ((Message -> m ()) -> Command m) -> (Message -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m ->
    Message -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> Text -> FilePath -> m ()
respondAsset Message
m Text
"literally-satan.png" FilePath
"cl/Bool.png"