{-# 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 Parsec Void String [Either String Card]
-> String
-> String
-> Either (ParseErrorBundle String Void) [Either String Card]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void String [Either String Card]
pCards String
"failed when parsing cards" String
s of
  Left ParseErrorBundle String Void
parseErrorBundle -> String -> Either String [Card]
forall a b. a -> Either a b
Left (String -> Either String [Card]) -> String -> Either String [Card]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String Void -> String
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 -> (String -> String) -> Either String [Card] -> Either String [Card]
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> String
wrap ([Either String Card] -> Either String [Card]
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 ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
unpack ([Text] -> [String]) -> (String -> [Text]) -> String -> [String]
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 (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

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

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

pHeader :: Parser String
pHeader :: ParsecT Void String Identity String
pHeader = do
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'#'
  ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token String] -> ParsecT Void String Identity (Token String)
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
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'!'
  Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'['
  String
alt <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
']')
  Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'('
  String
img <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
')')
  External -> Parser External
forall (m :: * -> *) a. Monad m => a -> m a
return (External -> Parser External) -> External -> Parser External
forall a b. (a -> b) -> a -> b
$ String -> String -> External
Image String
alt String
img

pLatex :: Parser External
pLatex :: Parser External
pLatex = do
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"```"
  String -> External
Latex (String -> External)
-> ParsecT Void String Identity String -> Parser External
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens String -> ParsecT Void String Identity (Tokens String)
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 =  External -> Maybe External
forall a. a -> Maybe a
Just (External -> Maybe External)
-> Parser External -> Parser (Maybe External)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser External -> Parser External
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser External
pImage
              Parser (Maybe External)
-> Parser (Maybe External) -> Parser (Maybe External)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> External -> Maybe External
forall a. a -> Maybe a
Just (External -> Maybe External)
-> Parser External -> Parser (Maybe External)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser External -> Parser External
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser External
pLatex
              Parser (Maybe External)
-> Parser (Maybe External) -> Parser (Maybe External)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe External -> Parser (Maybe External)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe External
forall a. Maybe a
Nothing

pMultChoice :: CardParser
pMultChoice :: Parser (Either String Card)
pMultChoice = do
  String
header <- ParsecT Void String Identity String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [(Char, String)]
choices <- Parser (Char, String)
pChoice Parser (Char, String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [(Char, String)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity 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 <- ParsecT Void String Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
                      Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> (String -> Either String Card)
-> String
-> Parser (Either String Card)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Card
forall a b. a -> Either a b
Left (String -> Parser (Either String Card))
-> String -> Parser (Either String Card)
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourcePosPretty SourcePos
pos String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
errMsg
    Right (CorrectOption
correct, [IncorrectOption]
incorrects) -> Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> (Card -> Either String Card)
-> Card
-> Parser (Either String Card)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Either String Card
forall a b. b -> Either a b
Right (Card -> Parser (Either String Card))
-> Card -> Parser (Either String Card)
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 <- [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'*',Char
'-']
  ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  String
text <- ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity String
choicePrefix ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
ParsecT Void String Identity (Tokens String)
seperator ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
forall a. ParsecT Void String Identity [a]
eof'))
  (Char, String) -> Parser (Char, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
kind, String
text)

choicePrefix :: Parser String
choicePrefix :: ParsecT Void String Identity String
choicePrefix =  Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"- "
            ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens String -> ParsecT Void String Identity (Tokens String)
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 <- ParsecT Void String Identity String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [Option]
options <- Parser Option
pOption Parser Option
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity [Option]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'['))
  Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> (Card -> Either String Card)
-> Card
-> Parser (Either String Card)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Either String Card
forall a b. b -> Either a b
Right (Card -> Parser (Either String Card))
-> Card -> Parser (Either String Card)
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> NonEmpty Option -> Card
MultipleAnswer String
header Maybe External
img ([Option] -> NonEmpty Option
forall a. [a] -> NonEmpty a
NE.fromList [Option]
options)

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

pReorder :: CardParser
pReorder :: Parser (Either String Card)
pReorder = do
  String
header <- ParsecT Void String Identity String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  [(Int, String)]
elements <- Parser (Int, String)
pReorderElement Parser (Int, String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [(Int, String)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity String
pReorderPrefix)
  let numbers :: [Int]
numbers = ((Int, String) -> Int) -> [(Int, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> Int
forall a b. (a, b) -> a
fst [(Int, String)]
elements
  if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
numbers) [Int
1..[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
numbers]
    then Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> (Card -> Either String Card)
-> Card
-> Parser (Either String Card)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Card -> Either String Card
forall a b. b -> Either a b
Right (Card -> Parser (Either String Card))
-> Card -> Parser (Either String Card)
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> NonEmpty (Int, String) -> Card
Reorder String
header Maybe External
img ([(Int, String)] -> NonEmpty (Int, String)
forall a. [a] -> NonEmpty a
NE.fromList [(Int, String)]
elements)
    else do SourcePos
pos <- ParsecT Void String Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> (String -> Either String Card)
-> String
-> Parser (Either String Card)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Card
forall a b. a -> Either a b
Left (String -> Parser (Either String Card))
-> String -> Parser (Either String Card)
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourcePosPretty SourcePos
pos String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
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" 
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
numbers)

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

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

pOpen :: CardParser
pOpen :: Parser (Either String Card)
pOpen = do
  String
header <- ParsecT Void String Identity String
pHeader
  Maybe External
img <- Parser (Maybe External)
pMaybeExternal
  ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity String
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

  Either String Card -> Parser (Either String Card)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Card -> Parser (Either String Card))
-> Either String Card -> Parser (Either String Card)
forall a b. (a -> b) -> a -> b
$ Card -> Either String Card
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 =  Parser Sentence -> Parser Sentence
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Sentence
pPerforated
         Parser Sentence -> Parser Sentence -> Parser Sentence
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 (Sentence -> Sentence) -> Parser Sentence -> Parser Sentence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Sentence
pSentence 

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

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

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

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

eof' :: ParsecT Void String Identity [a]
eof' = ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT Void String Identity ()
-> ParsecT Void String Identity [a]
-> ParsecT Void String Identity [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> ParsecT Void String Identity [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] ParsecT Void String Identity [a]
-> String -> ParsecT Void String Identity [a]
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 <- Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"---"
  ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity [Tokens String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  Tokens String -> ParsecT Void String Identity (Tokens String)
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
_ [] = String -> Parser (Either String (CorrectOption, [IncorrectOption]))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"woops"
    makeMultipleChoice' [CorrectOption
c] [IncorrectOption]
ics Int
_ [] = Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (CorrectOption, [IncorrectOption])
 -> Parser (Either String (CorrectOption, [IncorrectOption])))
-> Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall a b. (a -> b) -> a -> b
$ (CorrectOption, [IncorrectOption])
-> Either String (CorrectOption, [IncorrectOption])
forall a b. b -> Either a b
Right (CorrectOption
c, [IncorrectOption] -> [IncorrectOption]
forall a. [a] -> [a]
reverse [IncorrectOption]
ics)
    makeMultipleChoice' [CorrectOption]
_ [IncorrectOption]
_ Int
_ [] = Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (CorrectOption, [IncorrectOption])
 -> Parser (Either String (CorrectOption, [IncorrectOption])))
-> Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall a b. (a -> b) -> a -> b
$ String -> Either String (CorrectOption, [IncorrectOption])
forall a b. a -> Either a b
Left (String
"multiple choice had multiple correct answers: \n" String -> String -> String
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 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text) IncorrectOption -> [IncorrectOption] -> [IncorrectOption]
forall a. a -> [a] -> [a]
: [IncorrectOption]
ics) (Int
iInt -> Int -> Int
forall 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 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace' String
text) CorrectOption -> [CorrectOption] -> [CorrectOption]
forall a. a -> [a] -> [a]
: [CorrectOption]
cs) [IncorrectOption]
ics (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Char, String)]
opts
    makeMultipleChoice' [CorrectOption]
_  [IncorrectOption]
_   Int
_ [(Char, String)]
_ = Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (CorrectOption, [IncorrectOption])
 -> Parser (Either String (CorrectOption, [IncorrectOption])))
-> Either String (CorrectOption, [IncorrectOption])
-> Parser (Either String (CorrectOption, [IncorrectOption]))
forall a b. (a -> b) -> a -> b
$ String -> Either String (CorrectOption, [IncorrectOption])
forall a b. a -> Either a b
Left String
"impossible"

    showPretty :: [(Char, String)] -> String
    showPretty :: [(Char, String)] -> String
showPretty = ((Char, String) -> String -> String)
-> String -> [(Char, String)] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) (String -> String -> String)
-> ((Char, String) -> String) -> (Char, String) -> String -> String
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] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> 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 Char -> String -> Bool
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