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

--                     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
"# " 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))

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

--                         Pre    Gap               Post
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