module Types where
import Data.Functor
import Data.List ( intercalate, intersperse )
import Data.List.NonEmpty (NonEmpty)
import System.FilePath ( (</>) )
import System.Process ( runCommand, readProcess )
import System.Info ( os )
import System.IO ( openTempFile, hPutStrLn, hClose )
import qualified Data.List.NonEmpty as NE
import qualified System.Directory as D

--                     Word   Description

data Card = Definition { 
            Card -> String
question   :: String,
            Card -> Maybe External
external   :: Maybe External,
            Card -> String
definition :: String }
          | OpenQuestion {
            question   :: String,
            external   :: Maybe External,
            Card -> Perforated
perforated :: Perforated }
          | MultipleChoice {
            question   :: String,
            external   :: Maybe External,
            Card -> CorrectOption
correct    :: CorrectOption,
            Card -> [IncorrectOption]
incorrects :: [IncorrectOption]}
          | MultipleAnswer {
            question   :: String,
            external   :: Maybe External,
            Card -> NonEmpty Option
options    :: NonEmpty Option }
          | Reorder {
            question   :: String,
            external   :: Maybe External,
            Card -> NonEmpty (Int, String)
elements   :: NonEmpty (Int, String)
          }

instance Show Card where
  show :: Card -> String
show Card
card = let showHeader :: ShowS
showHeader String
h = String
"# " forall a. Semigroup a => a -> a -> a
<> String
h forall a. Semigroup a => a -> a -> a
<> String
"\n"
    in case Card
card of
      Definition String
h Maybe External
img String
descr -> ShowS
showHeader String
h forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. Semigroup a => a -> a -> a
<>String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe External
img forall a. Semigroup a => a -> a -> a
<> String
descr
      OpenQuestion String
h Maybe External
img Perforated
p -> ShowS
showHeader String
h forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. Semigroup a => a -> a -> a
<>String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe External
img forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Perforated
p
      MultipleChoice String
h Maybe External
img CorrectOption
c [IncorrectOption]
inc -> 
        ShowS
showHeader String
h forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. Semigroup a => a -> a -> a
<>String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe External
img forall a. Semigroup a => a -> a -> a
<> CorrectOption -> [IncorrectOption] -> String
showMultipleChoice CorrectOption
c [IncorrectOption]
inc
      MultipleAnswer String
h Maybe External
img NonEmpty Option
opts ->
        ShowS
showHeader String
h forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. Semigroup a => a -> a -> a
<>String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe External
img forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines' (forall a. NonEmpty a -> [a]
NE.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a. Show a => a -> String
show NonEmpty Option
opts))
      Reorder String
h Maybe External
img NonEmpty (Int, String)
elts -> 
        ShowS
showHeader String
h forall a. Semigroup a => a -> a -> a
<>forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. Semigroup a => a -> a -> a
<>String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe External
img forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines' (forall a. NonEmpty a -> [a]
NE.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int, String) -> String
showReorder NonEmpty (Int, String)
elts))

--              alt   file

data External = Image String String
              | Latex String

instance Show External where
  show :: External -> String
show (Image String
alt String
file) = String
"![" forall a. Semigroup a => a -> a -> a
<> String
alt forall a. Semigroup a => a -> a -> a
<> String
"]" forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> String
file forall a. Semigroup a => a -> a -> a
<> String
")"
  show (Latex String
text) = String
"```\n" forall a. Semigroup a => a -> a -> a
<> String
text forall a. Semigroup a => a -> a -> a
<> String
"```" 

openCommand :: String
openCommand :: String
openCommand = case String
os of
  String
"darwin"  -> String
"open"
  String
"linux"   -> String
"xdg-open"
  String
"mingw32" -> String
""
  String
_         -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown OS (" forall a. Semigroup a => a -> a -> a
<> String
os forall a. Semigroup a => a -> a -> a
<> String
") for opening files"

openFile :: FilePath -> FilePath -> IO ()
openFile :: String -> String -> IO ()
openFile String
origin String
relative = String -> IO ()
openFile' (String
origin String -> ShowS
</> String
relative)

openFile' :: FilePath -> IO ()
openFile' :: String -> IO ()
openFile' String
fp = do
  Bool
exists <- String -> IO Bool
D.doesFileExist String
fp 
  if Bool
exists
    then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> IO ProcessHandle
runCommand (String
openCommand forall a. Semigroup a => a -> a -> a
<> String
" \"" forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
"\"")
    else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"The file you were trying to open does not exist: " forall a. Semigroup a => a -> a -> a
<> String
fp

openLatex :: String -> IO ()
openLatex :: String -> IO ()
openLatex String
latex = do
  let packages :: [String]
packages = [String
"amsfonts", String
"mathtools"]
      text :: String
text = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"\\documentclass[preview]{standalone}" ]
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> String
"\\usepackage{"forall a. Semigroup a => a -> a -> a
<>String
pforall a. Semigroup a => a -> a -> a
<>String
"}") [String]
packages forall a. [a] -> [a] -> [a]
++
          [ String
"\\begin{document}"
          , String
latex
          , String
"\\end{document}" ]
  String
dir <- IO String
D.getTemporaryDirectory
  (String
tempfile, Handle
temph) <- String -> String -> IO (String, Handle)
openTempFile String
dir String
"hascard-latex-"
  Handle -> String -> IO ()
hPutStrLn Handle
temph String
text
  Handle -> IO ()
hClose Handle
temph
  String -> [String] -> String -> IO String
readProcess String
"pdflatex" [String
"-output-directory", String
dir, String
tempfile] String
""
  String -> IO ()
openFile' (String
tempfile forall a. Semigroup a => a -> a -> a
<> String
".pdf")

openCardExternal :: FilePath -> Card -> IO ()
openCardExternal :: String -> Card -> IO ()
openCardExternal String
origin Card
card =
  case Card -> Maybe External
external Card
card of
    Maybe External
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (Image String
_ String
relative) -> String -> String -> IO ()
openFile String
origin String
relative
    Just (Latex String
text) -> String -> IO ()
openLatex String
text

whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
f Maybe a
mg 

data Type = Incorrect | Correct
  deriving (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, 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)
data CorrectOption = CorrectOption Int String
  deriving Int -> CorrectOption -> ShowS
[CorrectOption] -> ShowS
CorrectOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CorrectOption] -> ShowS
$cshowList :: [CorrectOption] -> ShowS
show :: CorrectOption -> String
$cshow :: CorrectOption -> String
showsPrec :: Int -> CorrectOption -> ShowS
$cshowsPrec :: Int -> CorrectOption -> ShowS
Show
newtype IncorrectOption = IncorrectOption String
  deriving Int -> IncorrectOption -> ShowS
[IncorrectOption] -> ShowS
IncorrectOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncorrectOption] -> ShowS
$cshowList :: [IncorrectOption] -> ShowS
show :: IncorrectOption -> String
$cshow :: IncorrectOption -> String
showsPrec :: Int -> IncorrectOption -> ShowS
$cshowsPrec :: Int -> IncorrectOption -> ShowS
Show
data Option = Option Type String
instance Show Option where
  show :: Option -> String
show (Option Type
Correct String
str)   = String
"[*] " forall a. Semigroup a => a -> a -> a
<> String
str
  show (Option Type
Incorrect String
str) = String
"[ ] " forall a. Semigroup a => a -> a -> a
<> String
str

--                         Pre    Gap               Post

data Sentence = Perforated String (NonEmpty String) Sentence
              | Normal String

instance Show Sentence where
  show :: Sentence -> String
show = forall a.
(String -> a)
-> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence forall a. a -> a
id (\String
pre NonEmpty String
gap String
sent -> String
pre forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse String
"|" NonEmpty String
gap) forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> String
sent)

data Perforated = P String (NonEmpty String) Sentence

instance Show Perforated where
  show :: Perforated -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perforated -> Sentence
perforatedToSentence

listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice CorrectOption
c = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' [] Int
0 CorrectOption
c
  where listMultipleChoice' :: [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' [String]
opts Int
i (CorrectOption Int
j String
cStr) [] = 
          if Int
i forall a. Eq a => a -> a -> Bool
== Int
j
            then String
cStr forall a. a -> [a] -> [a]
: [String]
opts
            else [String]
opts
        listMultipleChoice' [String]
opts Int
i c' :: CorrectOption
c'@(CorrectOption Int
j String
cStr) ics :: [IncorrectOption]
ics@(IncorrectOption String
icStr : [IncorrectOption]
ics') = 
          if Int
i forall a. Eq a => a -> a -> Bool
== Int
j
            then [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' (String
cStr  forall a. a -> [a] -> [a]
: [String]
opts) (Int
iforall a. Num a => a -> a -> a
+Int
1) CorrectOption
c' [IncorrectOption]
ics
            else [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' (String
icStr forall a. a -> [a] -> [a]
: [String]
opts) (Int
iforall a. Num a => a -> a -> a
+Int
1) CorrectOption
c' [IncorrectOption]
ics'

unlines' :: [String] -> String
unlines' :: [String] -> String
unlines' = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"

showMultipleChoice :: CorrectOption -> [IncorrectOption] -> String
showMultipleChoice :: CorrectOption -> [IncorrectOption] -> String
showMultipleChoice c :: CorrectOption
c@(CorrectOption Int
i String
_) [IncorrectOption]
inc = 
  [String] -> String
unlines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
showOne forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice CorrectOption
c [IncorrectOption]
inc)
    where showOne :: (Int, String) -> String
showOne (Int
j, String
s) = (if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then String
"* " else String
"- ") forall a. Semigroup a => a -> a -> a
<> String
s

showReorder :: (Int, String) -> String
showReorder :: (Int, String) -> String
showReorder (Int
i, String
s) = forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
". " forall a. Semigroup a => a -> a -> a
<> String
s

cardsToString :: [Card] -> String
cardsToString :: [Card] -> String
cardsToString = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
"---" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show

nGapsInSentence :: Sentence -> Int
nGapsInSentence :: Sentence -> Int
nGapsInSentence = forall {t}. Num t => t -> Sentence -> t
nGapsInSentence' Int
0
  where
    nGapsInSentence' :: t -> Sentence -> t
nGapsInSentence' t
acc (Normal String
_) = t
acc
    nGapsInSentence' t
acc (Perforated String
_ NonEmpty String
_ Sentence
post) = t -> Sentence -> t
nGapsInSentence' (t
1forall a. Num a => a -> a -> a
+t
acc) Sentence
post

foldSentence :: (String -> a) -> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence :: forall a.
(String -> a)
-> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence String -> a
norm String -> NonEmpty String -> a -> a
perf = Sentence -> a
f where
  f :: Sentence -> a
f (Normal String
text) = String -> a
norm String
text
  f (Perforated String
pre NonEmpty String
gap Sentence
sent) = String -> NonEmpty String -> a -> a
perf String
pre NonEmpty String
gap (Sentence -> a
f Sentence
sent)

foldSentenceIndex :: (String -> Int -> a) -> (String -> NonEmpty String -> a -> Int -> a) -> Sentence -> a
foldSentenceIndex :: forall a.
(String -> Int -> a)
-> (String -> NonEmpty String -> a -> Int -> a) -> Sentence -> a
foldSentenceIndex String -> Int -> a
norm String -> NonEmpty String -> a -> Int -> a
perf = Int -> Sentence -> a
f Int
0 where
  f :: Int -> Sentence -> a
f Int
i (Normal String
text) = String -> Int -> a
norm String
text Int
i
  f Int
i (Perforated String
pre NonEmpty String
gap Sentence
sent) = String -> NonEmpty String -> a -> Int -> a
perf String
pre NonEmpty String
gap (Int -> Sentence -> a
f (Int
iforall a. Num a => a -> a -> a
+Int
1) Sentence
sent) Int
i

perforatedToSentence :: Perforated -> Sentence
perforatedToSentence :: Perforated -> Sentence
perforatedToSentence (P String
pre NonEmpty String
gap Sentence
sentence) = String -> NonEmpty String -> Sentence -> Sentence
Perforated String
pre NonEmpty String
gap Sentence
sentence

nGapsInPerforated :: Perforated -> Int
nGapsInPerforated :: Perforated -> Int
nGapsInPerforated = Sentence -> Int
nGapsInSentence forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perforated -> Sentence
perforatedToSentence

sentenceToGaps :: Sentence -> [NonEmpty String]
sentenceToGaps :: Sentence -> [NonEmpty String]
sentenceToGaps = forall a.
(String -> a)
-> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence (forall a b. a -> b -> a
const []) (\String
_ NonEmpty String
gap [NonEmpty String]
acc -> NonEmpty String
gap forall a. a -> [a] -> [a]
: [NonEmpty String]
acc)

isOptionCorrect :: Option -> Bool
isOptionCorrect :: Option -> Bool
isOptionCorrect (Option Type
Correct String
_) = Bool
True
isOptionCorrect Option
_                  = Bool
False