{-# 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 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
= 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' :: [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