{-# LANGUAGE TemplateHaskell #-}
module Import where
import Control.Monad (void)
import Data.Char (toLower, isSpace)
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Void
import Lens.Micro.Platform
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Debug
import Types
data ImportType = Def | Open
data ImportOpts = ImportOpts
{ ImportOpts -> String
_optInput :: String
, ImportOpts -> String
_optOutput :: String
, ImportOpts -> ImportType
_optImportType :: ImportType
, ImportOpts -> Bool
_optImportReverse :: Bool
, ImportOpts -> String
_optRowDelimiter :: String
, ImportOpts -> String
_optTermDefDelimiter :: String
, ImportOpts -> Maybe String
_optDefDelimiter :: Maybe String }
makeLenses ''ImportOpts
instance Read ImportType where
readsPrec :: Int -> ReadS ImportType
readsPrec Int
_ String
input =
case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
input of
String
xs | String
"open" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Open, forall a. Int -> [a] -> [a]
drop Int
4 String
xs)]
| String
"def" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def, forall a. Int -> [a] -> [a]
drop Int
3 String
xs)]
| String
"definition" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def, forall a. Int -> [a] -> [a]
drop Int
10 String
xs)]
| Bool
otherwise -> []
type Parser = Parsec Void String
rowDelimiter :: String
rowDelimiter :: String
rowDelimiter = String
"\n\n"
termDefDelimiter :: String
termDefDelimiter :: String
termDefDelimiter = String
"\t"
defDelimiter :: String
defDelimiter :: String
defDelimiter = String
","
parseImportInput :: ImportOpts -> String -> Either String [Card]
parseImportInput :: ImportOpts -> String -> Either String [Card]
parseImportInput ImportOpts
opts String
s = case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ImportOpts -> Parser [Card]
pImportInput ImportOpts
opts) String
"failed import parsing" 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 [Card]
cards -> forall a b. b -> Either a b
Right [Card]
cards
pImportInput :: ImportOpts -> Parser [Card]
pImportInput :: ImportOpts -> Parser [Card]
pImportInput ImportOpts
opts = ImportOpts -> Parser Card
pRow ImportOpts
opts forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy1` (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity (Tokens String)
pRowDelimiter forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pRowDelimiter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
where pRowDelimiter :: ParsecT Void String Identity (Tokens String)
pRowDelimiter = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts String
optRowDelimiter)
pRow :: ImportOpts -> Parser Card
pRow :: ImportOpts -> Parser Card
pRow ImportOpts
opts =
let
pTermDefDelimiter :: ParsecT Void String Identity (Tokens String)
pTermDefDelimiter = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts String
optTermDefDelimiter)
pDefDelimiter :: Maybe (ParsecT Void String Identity (Tokens String))
pDefDelimiter = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts (Maybe String)
optDefDelimiter)
pTerm :: ParsecT Void String Identity [Token String]
pTerm = 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts
pDefs :: ParsecT Void String Identity [String]
pDefs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) (ImportOpts -> Parser String
pDef ImportOpts
opts)) (ImportOpts -> Parser String
pDef ImportOpts
opts forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy`) Maybe (ParsecT Void String Identity (Tokens String))
pDefDelimiter
defBeforeTerm :: Bool
defBeforeTerm = ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts Bool
optImportReverse
in
case (Bool
defBeforeTerm, ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts ImportType
optImportType) of
(Bool
False, ImportType
Open) -> do
String
term <- Parser String
pTerm
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
[String]
defs <- ParsecT Void String Identity [String]
pDefs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> Perforated -> Card
OpenQuestion (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) forall a. Maybe a
Nothing (String -> NonEmpty String -> Sentence -> Perforated
P String
"" (forall a. [a] -> NonEmpty a
NE.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) [String]
defs)) (String -> Sentence
Normal String
""))
(Bool
True, ImportType
Open) -> do
[String]
defs <- ParsecT Void String Identity [String]
pDefs
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
String
term <- Parser String
pTerm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> Perforated -> Card
OpenQuestion (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) forall a. Maybe a
Nothing (String -> NonEmpty String -> Sentence -> Perforated
P String
"" (forall a. [a] -> NonEmpty a
NE.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) [String]
defs)) (String -> Sentence
Normal String
""))
(Bool
False, ImportType
Def) -> do
String
term <- Parser String
pTerm
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
String
def <- ImportOpts -> Parser String
pDef ImportOpts
opts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> String -> Card
Definition (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) forall a. Maybe a
Nothing String
def
(Bool
True, ImportType
Def) -> do
String
def <- ImportOpts -> Parser String
pDef ImportOpts
opts
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
String
term <- Parser String
pTerm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> String -> Card
Definition (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) forall a. Maybe a
Nothing String
def
pDef :: ImportOpts -> Parser String
pDef :: ImportOpts -> Parser String
pDef ImportOpts
opts = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts)
(\ParsecT Void String Identity (Tokens String)
pDefDelimiter -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pDefDelimiter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts)
(forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts (Maybe String)
optDefDelimiter))
pSpecial :: ImportOpts -> Parser ()
pSpecial :: ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts = forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pTermDefDelimiter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pRowDelimiter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) forall a. Semigroup a => a -> a -> a
<> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
where pTermDefDelimiter :: ParsecT Void String Identity (Tokens String)
pTermDefDelimiter = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts String
optTermDefDelimiter)
pRowDelimiter :: ParsecT Void String Identity (Tokens String)
pRowDelimiter = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ImportOpts String
optRowDelimiter)