{-# 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 (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)