{-# 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 (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
input of
String
xs | String
"open" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Open, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
xs)]
| String
"def" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
xs)]
| String
"definition" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> [(ImportType
Def, Int -> String -> String
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 Parsec Void String [Card]
-> String -> String -> Either (ParseErrorBundle String Void) [Card]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ImportOpts -> Parsec Void String [Card]
pImportInput ImportOpts
opts) String
"failed import parsing" 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 [Card]
cards -> [Card] -> Either String [Card]
forall a b. b -> Either a b
Right [Card]
cards
pImportInput :: ImportOpts -> Parser [Card]
pImportInput :: ImportOpts -> Parsec Void String [Card]
pImportInput ImportOpts
opts = ImportOpts -> Parser Card
pRow ImportOpts
opts Parser Card
-> ParsecT Void String Identity () -> Parsec Void String [Card]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy1` (ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 (Tokens String)
pRowDelimiter ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol)) ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pRowDelimiter ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity [String]
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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) ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
where pRowDelimiter :: ParsecT Void String Identity (Tokens String)
pRowDelimiter = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts ImportOpts -> Getting String ImportOpts String -> String
forall s a. s -> Getting a s a -> a
^. Getting String ImportOpts String
Lens' ImportOpts String
optRowDelimiter)
pRow :: ImportOpts -> Parser Card
pRow :: ImportOpts -> Parser Card
pRow ImportOpts
opts =
let
pTermDefDelimiter :: ParsecT Void String Identity (Tokens String)
pTermDefDelimiter = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts ImportOpts -> Getting String ImportOpts String -> String
forall s a. s -> Getting a s a -> a
^. Getting String ImportOpts String
Lens' ImportOpts String
optTermDefDelimiter)
pDefDelimiter :: Maybe (ParsecT Void String Identity (Tokens String))
pDefDelimiter = String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> ParsecT Void String Identity (Tokens String))
-> Maybe String
-> Maybe (ParsecT Void String Identity (Tokens String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportOpts
opts ImportOpts
-> Getting (Maybe String) ImportOpts (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) ImportOpts (Maybe String)
Lens' ImportOpts (Maybe String)
optDefDelimiter)
pTerm :: ParsecT Void String Identity String
pTerm = ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> 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 ()
-> ParsecT Void String Identity String)
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity ()
-> ParsecT Void String Identity String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts
pDefs :: ParsecT Void String Identity [String]
pDefs = ParsecT Void String Identity [String]
-> (ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity [String])
-> Maybe (ParsecT Void String Identity (Tokens String))
-> ParsecT Void String Identity [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (ImportOpts -> ParsecT Void String Identity String
pDef ImportOpts
opts)) (ImportOpts -> ParsecT Void String Identity String
pDef ImportOpts
opts ParsecT Void String Identity String
-> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity [String]
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 ImportOpts -> Getting Bool ImportOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ImportOpts Bool
Lens' ImportOpts Bool
optImportReverse
in
case (Bool
defBeforeTerm, ImportOpts
opts ImportOpts
-> Getting ImportType ImportOpts ImportType -> ImportType
forall s a. s -> Getting a s a -> a
^. Getting ImportType ImportOpts ImportType
Lens' ImportOpts ImportType
optImportType) of
(Bool
False, ImportType
Open) -> do
String
term <- ParsecT Void String Identity String
pTerm
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
[String]
defs <- ParsecT Void String Identity [String]
pDefs
Card -> Parser Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> Parser Card) -> Card -> Parser Card
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> Perforated -> Card
OpenQuestion ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) Maybe External
forall a. Maybe a
Nothing (String -> NonEmpty String -> Sentence -> Perforated
P String
"" ([String] -> NonEmpty String
forall a. [a] -> NonEmpty a
NE.fromList ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
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 <- ParsecT Void String Identity String
pTerm
Card -> Parser Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> Parser Card) -> Card -> Parser Card
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> Perforated -> Card
OpenQuestion ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) Maybe External
forall a. Maybe a
Nothing (String -> NonEmpty String -> Sentence -> Perforated
P String
"" ([String] -> NonEmpty String
forall a. [a] -> NonEmpty a
NE.fromList ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) [String]
defs)) (String -> Sentence
Normal String
""))
(Bool
False, ImportType
Def) -> do
String
term <- ParsecT Void String Identity String
pTerm
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
String
def <- ImportOpts -> ParsecT Void String Identity String
pDef ImportOpts
opts
Card -> Parser Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> Parser Card) -> Card -> Parser Card
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> String -> Card
Definition ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) Maybe External
forall a. Maybe a
Nothing String
def
(Bool
True, ImportType
Def) -> do
String
def <- ImportOpts -> ParsecT Void String Identity String
pDef ImportOpts
opts
ParsecT Void String Identity (Tokens String)
pTermDefDelimiter
String
term <- ParsecT Void String Identity String
pTerm
Card -> Parser Card
forall (m :: * -> *) a. Monad m => a -> m a
return (Card -> Parser Card) -> Card -> Parser Card
forall a b. (a -> b) -> a -> b
$ String -> Maybe External -> String -> Card
Definition ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
term) Maybe External
forall a. Maybe a
Nothing String
def
pDef :: ImportOpts -> Parser String
pDef :: ImportOpts -> ParsecT Void String Identity String
pDef ImportOpts
opts = ParsecT Void String Identity String
-> (ParsecT Void String Identity String
-> ParsecT Void String Identity String)
-> Maybe (ParsecT Void String Identity String)
-> ParsecT Void String Identity String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> 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 ()
-> ParsecT Void String Identity String)
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity ()
-> ParsecT Void String Identity String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts)
(\ParsecT Void String Identity String
pDefDelimiter -> ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> 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 ()
-> ParsecT Void String Identity String)
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> (ParsecT Void String Identity ()
-> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity ()
-> ParsecT Void String Identity String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity String
pDefDelimiter ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts)
(String -> ParsecT Void String Identity String
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> ParsecT Void String Identity String)
-> Maybe String -> Maybe (ParsecT Void String Identity String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportOpts
opts ImportOpts
-> Getting (Maybe String) ImportOpts (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) ImportOpts (Maybe String)
Lens' ImportOpts (Maybe String)
optDefDelimiter))
pSpecial :: ImportOpts -> Parser ()
pSpecial :: ImportOpts -> ParsecT Void String Identity ()
pSpecial ImportOpts
opts = ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pTermDefDelimiter ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity (Tokens String)
pRowDelimiter ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a. Semigroup a => a -> a -> a
<> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
where pTermDefDelimiter :: ParsecT Void String Identity (Tokens String)
pTermDefDelimiter = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts ImportOpts -> Getting String ImportOpts String -> String
forall s a. s -> Getting a s a -> a
^. Getting String ImportOpts String
Lens' ImportOpts String
optTermDefDelimiter)
pRowDelimiter :: ParsecT Void String Identity (Tokens String)
pRowDelimiter = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ImportOpts
opts ImportOpts -> Getting String ImportOpts String -> String
forall s a. s -> Getting a s a -> a
^. Getting String ImportOpts String
Lens' ImportOpts String
optRowDelimiter)