module Types where
import Data.Functor
import Data.List
import Data.List.NonEmpty (NonEmpty)
import System.FilePath
import System.Process
import System.Info
import System.IO
import qualified Data.List.NonEmpty as NE
import qualified System.Directory as D
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
"# " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
h String -> ShowS
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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (External -> String) -> Maybe External -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"\n") ShowS -> (External -> String) -> External -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. External -> String
forall a. Show a => a -> String
show) Maybe External
img String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
descr
OpenQuestion String
h Maybe External
img Perforated
p -> ShowS
showHeader String
h String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (External -> String) -> Maybe External -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"\n") ShowS -> (External -> String) -> External -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. External -> String
forall a. Show a => a -> String
show) Maybe External
img String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Perforated -> String
forall a. Show a => a -> String
show Perforated
p
MultipleChoice String
h Maybe External
img CorrectOption
c [IncorrectOption]
inc ->
ShowS
showHeader String
h String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (External -> String) -> Maybe External -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"\n") ShowS -> (External -> String) -> External -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. External -> String
forall a. Show a => a -> String
show) Maybe External
img String -> ShowS
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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (External -> String) -> Maybe External -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"\n") ShowS -> (External -> String) -> External -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. External -> String
forall a. Show a => a -> String
show) Maybe External
img String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines' (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList ((Option -> String) -> NonEmpty Option -> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Option -> String
forall a. Show a => a -> String
show NonEmpty Option
opts))
Reorder String
h Maybe External
img NonEmpty (Int, String)
elts ->
ShowS
showHeader String
h String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String -> (External -> String) -> Maybe External -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"\n") ShowS -> (External -> String) -> External -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. External -> String
forall a. Show a => a -> String
show) Maybe External
img String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines' (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList (((Int, String) -> String)
-> NonEmpty (Int, String) -> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int, String) -> String
showReorder NonEmpty (Int, String)
elts))
data External = Image String String
| Latex String
instance Show External where
show :: External -> String
show (Image String
alt String
file) = String
"![" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
alt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
file String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
show (Latex String
text) = String
"```\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
text String -> ShowS
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
_ -> ShowS
forall a. HasCallStack => String -> a
error String
"Unkown OS for opening images"
openImage :: FilePath -> FilePath -> IO ()
openImage :: String -> String -> IO ()
openImage String
origin String
relative = String -> IO ()
openImage' (String
origin String -> ShowS
</> String
relative)
openImage' :: FilePath -> IO ()
openImage' :: String -> IO ()
openImage' String
fp = do
Bool
exists <- String -> IO Bool
D.doesFileExist String
fp
if Bool
exists
then IO ProcessHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessHandle -> IO ()) -> IO ProcessHandle -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ProcessHandle
runCommand (String
openCommand String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\"")
else String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The image you were trying to open does not exist: " String -> ShowS
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 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"\\documentclass[preview]{standalone}" ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> String
"\\usepackage{"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
pString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"}") [String]
packages [String] -> [String] -> [String]
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] -> IO ()
callProcess String
"pdflatex" [String
"-output-directory", String
dir, String
tempfile]
String -> IO ()
openImage' (String
tempfile String -> ShowS
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 -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Image String
_ String
relative) -> String -> String -> IO ()
openImage String
origin String
relative
Just (Latex String
text) -> String -> IO ()
openLatex String
text
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust :: Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
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
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
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
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
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
(Int -> CorrectOption -> ShowS)
-> (CorrectOption -> String)
-> ([CorrectOption] -> ShowS)
-> Show CorrectOption
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
(Int -> IncorrectOption -> ShowS)
-> (IncorrectOption -> String)
-> ([IncorrectOption] -> ShowS)
-> Show IncorrectOption
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
"[*] " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str
show (Option Type
Incorrect String
str) = String
"[ ] " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str
data Sentence = Perforated String (NonEmpty String) Sentence
| Normal String
instance Show Sentence where
show :: Sentence -> String
show = ShowS -> (String -> NonEmpty String -> ShowS) -> Sentence -> String
forall a.
(String -> a)
-> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence ShowS
forall a. a -> a
id (\String
pre NonEmpty String
gap String
sent -> String
pre String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty String -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse String
"|" NonEmpty String
gap) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sent)
data Perforated = P String (NonEmpty String) Sentence
instance Show Perforated where
show :: Perforated -> String
show = Sentence -> String
forall a. Show a => a -> String
show (Sentence -> String)
-> (Perforated -> Sentence) -> Perforated -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perforated -> Sentence
perforatedToSentence
listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice :: CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice CorrectOption
c = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([IncorrectOption] -> [String]) -> [IncorrectOption] -> [String]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
then String
cStr String -> [String] -> [String]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
then [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' (String
cStr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
opts) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) CorrectOption
c' [IncorrectOption]
ics
else [String] -> Int -> CorrectOption -> [IncorrectOption] -> [String]
listMultipleChoice' (String
icStr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
opts) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) CorrectOption
c' [IncorrectOption]
ics'
unlines' :: [String] -> String
unlines' :: [String] -> String
unlines' = String -> [String] -> String
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' ([String] -> String)
-> ([(Int, String)] -> [String]) -> [(Int, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
showOne ([(Int, String)] -> String) -> [(Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then String
"* " else String
"- ") String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
showReorder :: (Int, String) -> String
showReorder :: (Int, String) -> String
showReorder (Int
i, String
s) = Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
cardsToString :: [Card] -> String
cardsToString :: [Card] -> String
cardsToString = [String] -> String
unlines ([String] -> String) -> ([Card] -> [String]) -> [Card] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"---" ([String] -> [String])
-> ([Card] -> [String]) -> [Card] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Card -> String) -> [Card] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Card -> String
forall a. Show a => a -> String
show
nGapsInSentence :: Sentence -> Int
nGapsInSentence :: Sentence -> Int
nGapsInSentence = Int -> Sentence -> Int
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
1t -> t -> t
forall a. Num a => a -> a -> a
+t
acc) Sentence
post
foldSentence :: (String -> a) -> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence :: (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 :: (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
iInt -> Int -> Int
forall 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 (Sentence -> Int) -> (Perforated -> Sentence) -> Perforated -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perforated -> Sentence
perforatedToSentence
sentenceToGaps :: Sentence -> [NonEmpty String]
sentenceToGaps :: Sentence -> [NonEmpty String]
sentenceToGaps = (String -> [NonEmpty String])
-> (String
-> NonEmpty String -> [NonEmpty String] -> [NonEmpty String])
-> Sentence
-> [NonEmpty String]
forall a.
(String -> a)
-> (String -> NonEmpty String -> a -> a) -> Sentence -> a
foldSentence ([NonEmpty String] -> String -> [NonEmpty String]
forall a b. a -> b -> a
const []) (\String
_ NonEmpty String
gap [NonEmpty String]
acc -> NonEmpty String
gap NonEmpty String -> [NonEmpty String] -> [NonEmpty String]
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