{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, KindSignatures, OverloadedStrings #-}
module Parser (parseCards) where
  
import Control.Arrow
import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Wrap
import Data.Text (pack, unpack)
import Types
import qualified Data.List.NonEmpty as NE

-- Type synonyms for convenience

type Parser = Parsec Void String
type CardParser = Parser (Either String Card)

uncurry3 :: (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 t -> t -> t -> t
f (t
a, t
b, t
c) = t -> t -> t -> t
f t
a t
b t
c

parseCards :: String -> Either String [Card]
parseCards :: String -> Either String [Card]
parseCards String
s = case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser [Either String Card]
pCards String
"failed when parsing cards" String
s of
  Left ParseErrorBundle String Void
parseErrorBundle -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (ParseErrorBundle String Void
parseErrorBundle :: ParseErrorBundle String Void)
  Right [Either String Card]
msgOrCards -> forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> String
wrap (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either String Card]
msgOrCards)
    where wrap :: String -> String
wrap = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapSettings -> Int -> Text -> [Text]
wrapTextToLines (WrapSettings
defaultWrapSettings {preserveIndentation :: Bool
preserveIndentation=Bool
False, breakLongWords :: Bool
breakLongWords=Bool
True}) Int
40 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

pCards :: Parser [Either String Card]
pCards :: Parser [Either String Card]
pCards = (Parser (Either String Card)
pCard forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy1` ParsecT Void String Identity (Tokens String)
seperator) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

pCard :: Parser (Either String Card)
pCard :: Parser (Either String Card)
pCard =  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Either String Card)
pMultChoice
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Either String Card)
pMultAnswer
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Either String Card)
pReorder
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Either String Card)
pOpen
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Either String Card)
pDef

pHeader :: Parser String
pHeader :: Parser String
pHeader = do
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#'
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\n', Char
'\r'])

pImage :: Parser External
pImage :: Parser External
pImage = do
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'!'
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
  String
alt <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']')
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
  String
img <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> External
Image String
alt String
img

pLatex :: Parser External
pLatex :: Parser External
pLatex = do
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"
  String -> External
Latex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"))

pMaybeExternal :: Parser (Maybe External)
pMaybeExternal :: Parser (Maybe External)
pMaybeExternal =  forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser External
pImage
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser External
pLatex
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

pMultChoice :: CardParser
pMultChoice :: Parser (Either String Card)
pMultChoice = do
  String
header <- Parser String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [(Char, String)]
choices <- Parser (Char, String)
pChoice forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser String
choicePrefix)
  Either String (CorrectOption, [IncorrectOption])
msgOrResult <- [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice [(Char, String)]
choices
  case Either String (CorrectOption, [IncorrectOption])
msgOrResult of
    Left String
errMsg -> do SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourcePosPretty SourcePos
pos forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
errMsg
    Right (CorrectOption
correct, [IncorrectOption]
incorrects) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String
-> Maybe External -> CorrectOption -> [IncorrectOption] -> Card
MultipleChoice String
header Maybe External
img CorrectOption
correct [IncorrectOption]
incorrects

pChoice :: Parser (Char, String)
pChoice :: Parser (Char, String)
pChoice = do
  Char
kind <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'*',Char
'-']
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  String
text <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser String
choicePrefix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity (Tokens String)
seperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void String Identity [a]
eof'))
  forall (m :: * -> *) a. Monad m => a -> m a
return (Char
kind, String
text)

choicePrefix :: Parser String
choicePrefix :: Parser String
choicePrefix =  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"- "
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"* "

pMultAnswer :: CardParser
pMultAnswer :: Parser (Either String Card)
pMultAnswer = do
  String
header <- Parser String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [Option]
options <- Parser Option
pOption forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> NonEmpty Option -> Card
MultipleAnswer String
header Maybe External
img (forall a. [a] -> NonEmpty a
NE.fromList [Option]
options)

pOption :: Parser Option
pOption :: Parser Option
pOption = do
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
  Char
kind <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'*',Char
'x',Char
' ']
  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"] "
  String
text <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity (Tokens String)
seperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"[" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void String Identity [a]
eof'))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> String -> Option
makeOption Char
kind (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text)

pReorder :: CardParser
pReorder :: Parser (Either String Card)
pReorder = do
  String
header <- Parser String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [(Int, String)]
elements <- Parser (Int, String)
pReorderElement forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser String
pReorderPrefix)
  let numbers :: [Int]
numbers = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, String)]
elements
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
numbers) [Int
1..forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
numbers]
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> NonEmpty (Int, String) -> Card
Reorder String
header Maybe External
img (forall a. [a] -> NonEmpty a
NE.fromList [(Int, String)]
elements)
    else do SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourcePosPretty SourcePos
pos forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
"A reordering question should have numbers starting from 1 and increase from there without skipping any numbers, but this is not the case:\n" 
                    forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int]
numbers)

pReorderElement :: Parser (Int, String)
pReorderElement :: Parser (Int, String)
pReorderElement = do
  String
int <- Parser String
pReorderPrefix
  String
text <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity (Tokens String)
seperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser String
pReorderPrefix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void String Identity [a]
eof'))
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => String -> a
read String
int, forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text)

pReorderPrefix :: Parser String
pReorderPrefix :: Parser String
pReorderPrefix = do
  String
int <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
". "
  forall (m :: * -> *) a. Monad m => a -> m a
return String
int

pOpen :: CardParser
pOpen :: Parser (Either String Card)
pOpen = do
  String
header <- Parser String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  (String
pre, NonEmpty String
gap) <- Parser (String, NonEmpty String)
pGap
  Sentence
sentence <- Parser Sentence
pSentence

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String -> Maybe External -> Perforated -> Card
OpenQuestion String
header Maybe External
img (String -> NonEmpty String -> Sentence -> Perforated
P String
pre NonEmpty String
gap Sentence
sentence))

pSentence :: Parser Sentence
pSentence :: Parser Sentence
pSentence =  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Sentence
pPerforated
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Sentence
pNormal

pPerforated :: Parser Sentence
pPerforated :: Parser Sentence
pPerforated = do
  (String
pre, NonEmpty String
gap) <- Parser (String, NonEmpty String)
pGap
  String -> NonEmpty String -> Sentence -> Sentence
Perforated String
pre NonEmpty String
gap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Sentence
pSentence 

chars :: ParsecT Void String Identity Char
chars = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity (Token String)
escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
escaped :: ParsecT Void String Identity (Token String)
escaped = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_'

pGap :: Parser (String, NE.NonEmpty String)
pGap :: Parser (String, NonEmpty String)
pGap = do
  String
pre <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
chars forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"_" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity (Tokens String)
seperator))
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_'
  [String]
gaps <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'_',Char
'|']) (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity (Tokens String)
gappedSpecialChars)) forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"|"
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_'
  forall (m :: * -> *) a. Monad m => a -> m a
return (String
pre, forall a. [a] -> NonEmpty a
NE.fromList [String]
gaps)

gappedSpecialChars :: ParsecT Void String Identity (Tokens String)
gappedSpecialChars =  ParsecT Void String Identity (Tokens String)
seperator
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"|"
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"_"

pNormal :: Parser Sentence
pNormal :: Parser Sentence
pNormal = do
  String
text <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'_']) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity (Tokens String)
seperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void String Identity [a]
eof'
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Sentence
Normal (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text))

pDef :: CardParser
pDef :: Parser (Either String Card)
pDef = do
  String
header <- Parser String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  String
descr <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
chars forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity (Tokens String)
seperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void String Identity [a]
eof'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String -> Maybe External -> String -> Card
Definition String
header Maybe External
img (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
descr))

eof' :: ParsecT Void String Identity [a]
eof' = forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [] forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end of file"

seperator :: ParsecT Void String Identity (Tokens String)
seperator = do
  Tokens String
sep <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"---"
  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  forall (m :: * -> *) a. Monad m => a -> m a
return Tokens String
sep

makeMultipleChoice :: [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice :: [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice [(Char, String)]
options = [CorrectOption]
-> [IncorrectOption]
-> Int
-> [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice' [] [] Int
0 [(Char, String)]
options
  where
    -- makeMultipleChoice' [] _ _ [] = Left ("multiple choice had no correct answer: \n" ++ showPretty options)

    makeMultipleChoice' :: [CorrectOption] -> [IncorrectOption] -> Int -> [(Char, String)] -> Parser (Either String (CorrectOption, [IncorrectOption]))
    makeMultipleChoice' :: [CorrectOption]
-> [IncorrectOption]
-> Int
-> [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice' [] [IncorrectOption]
_ Int
_ [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"woops"
    makeMultipleChoice' [CorrectOption
c] [IncorrectOption]
ics Int
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (CorrectOption
c, forall a. [a] -> [a]
reverse [IncorrectOption]
ics)
    makeMultipleChoice' [CorrectOption]
_ [IncorrectOption]
_ Int
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"multiple choice had multiple correct answers: \n" forall a. [a] -> [a] -> [a]
++ [(Char, String)] -> String
showPretty [(Char, String)]
options)
    makeMultipleChoice' [CorrectOption]
cs [IncorrectOption]
ics Int
i ((Char
'-', String
text) : [(Char, String)]
opts) = [CorrectOption]
-> [IncorrectOption]
-> Int
-> [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice' [CorrectOption]
cs (String -> IncorrectOption
IncorrectOption (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text) forall a. a -> [a] -> [a]
: [IncorrectOption]
ics) (Int
iforall a. Num a => a -> a -> a
+Int
1) [(Char, String)]
opts
    makeMultipleChoice' [CorrectOption]
cs [IncorrectOption]
ics Int
i ((Char
'*', String
text) : [(Char, String)]
opts) = [CorrectOption]
-> [IncorrectOption]
-> Int
-> [(Char, String)]
-> Parser (Either String (CorrectOption, [IncorrectOption]))
makeMultipleChoice' (Int -> String -> CorrectOption
CorrectOption Int
i (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text) forall a. a -> [a] -> [a]
: [CorrectOption]
cs) [IncorrectOption]
ics (Int
iforall a. Num a => a -> a -> a
+Int
1) [(Char, String)]
opts
    makeMultipleChoice' [CorrectOption]
_  [IncorrectOption]
_   Int
_ [(Char, String)]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"impossible"

    showPretty :: [(Char, String)] -> String
    showPretty :: [(Char, String)] -> String
showPretty = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, String) -> String
showOne) String
""

    showOne :: (Char, String) -> String
showOne (Char
c, String
s) = [Char
c] forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<>  String
s

makeOption :: Char -> String -> Option
makeOption :: Char -> String -> Option
makeOption Char
kind String
text
  | Char
kind forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'*',Char
'x'] = Type -> String -> Option
Option Type
Correct String
text
  | Bool
otherwise             = Type -> String -> Option
Option Type
Incorrect String
text

isSpace' :: Char -> Bool
isSpace' :: Char -> Bool
isSpace' Char
'\r' = Bool
True
isSpace' Char
a    = Char -> Bool
isSpace Char
a