{-# LANGUAGE TemplateHaskell #-}
module Import where
import Control.Monad (void)
import Data.Char (toLower, isSpace)
import Data.List
-- import Data.List.Split

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)