Improve import functionality

app/Main.hs

@@ -5,14 +5,17 @@ import UI
 import Control.Exception (displayException, try)
 import Control.Monad (void, when)
 import Data.Version (showVersion)
+import Data.Void
 import Lens.Micro.Platform
 import Paths_hascard (version)
 import Parser
-import Options.Applicative
+import Options.Applicative hiding (many)
 import System.Directory (makeAbsolute)
 import System.FilePath (takeExtension, takeBaseName, takeDirectory)
 import System.Process (runCommand)
 import System.Random.MWC (createSystemRandom)
+import Text.Megaparsec (parse, many, errorBundlePretty, ParseErrorBundle)
+import Text.Megaparsec.Char.Lexer (charLiteral)
 import qualified Data.Map.Strict as Map (empty)
 import qualified System.Directory as D
 import qualified Stack
@@ -34,12 +37,6 @@ data RunOpts = RunOpts
   , _optBlankMode    :: Bool
   }
 
-data ImportOpts = ImportOpts
-  { _optInput         :: String 
-  , _optOutput        :: String
-  , _optImportType    :: ImportType
-  , _optImportReverse :: Bool }
-
 makeLenses ''Opts
 makeLenses ''RunOpts
 makeLenses ''ImportOpts
@@ -63,7 +60,10 @@ opts :: Parser Opts
 opts = Opts
   <$> optional (hsubparser
     (  command "run" (info (Run <$> runOpts) ( progDesc "Run hascard with CLI options"))
-    <> command "import" (info (Import <$> importOpts) (progDesc "Convert a TAB delimited file to syntax compatible with hascard. So, terms and definitions should be seperated by tabs, and rows by new lines. When converting to 'open' cards, multiple correct answers can be seperated by semicolons (;), backslashes (/) or commas (,)."))))
+    <> command "import" (info (Import <$> importOpts) (progDesc "Convert a delimited text file (e.g. exported from Quizlet) to a file compatible with hascard.\
+    \ The delimiters can be specified via CLI options. By default, terms and definitions are assumed to be separated by tabs, and different cards by new lines.\
+    \ Either 'Definition' cards are generated (traditional flashcards), or 'Open question' cards (where the answer needs to be typed).\
+    \ For 'Open question' cards, a delimiter can be specified which separates multiple correct answers."))))
   <*> switch (long "version" <> short 'v' <> help "Show version number")
 
 runOpts :: Parser RunOpts
@@ -76,14 +76,18 @@ runOpts = RunOpts
 
 importOpts :: Parser ImportOpts
 importOpts = ImportOpts
-  <$> argument str (metavar "INPUT" <> help "A TSV file")
+  <$> argument str (metavar "INPUT" <> help "A delimited text file")
   <*> argument str (metavar "DESINATION" <> help "The filename/path to which the output should be saved")
-  <*> option auto (long "type" <> short 't' <> metavar "'open' or 'def'" <> help "The type of card to which the input is transformed, default: open" <> value Open)
+  <*> option auto (long "type" <> short 't' <> metavar "'open' or 'def'" <> help "The type of card to which the input is transformed; default: open." <> value Open)
   <*> switch (long "reverse" <> short 'r' <> help "Reverse direction of question and answer, i.e. right part becomes the question.")
+  <*> strOption (long "row-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different cards; default: \\n." <> value "\n")
+  <*> strOption (long "term-def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate terms and definitions; default: \\t." <> value "\t")
+  <*> optional (strOption (long "def-delimiter" <> metavar "delimiter" <> help "The delimiter used to separate different definitions for the same term; no delimiter is used by default."))
 
 optsWithHelp :: ParserInfo Opts
 optsWithHelp = info (opts <**> helper) $
-              fullDesc <> progDesc "Run the normal application with `hascard`. To run directly on a file, and with CLI options, see `hascard run --help`. For converting TAB seperated files, see `hascard import --help`."
+              fullDesc <> progDesc "Run the normal application with `hascard`. To run directly on a file, and with CLI options, see `hascard run --help`.\
+              \ For converting delimited text files, see `hascard import --help`."
               <> header "Hascard - a TUI for reviewing notes"
 
 nothingIf :: (a -> Bool) -> a -> Maybe a
@@ -138,15 +142,20 @@ start Nothing gs = runBrickFlashcards (gs `goToState` mainMenuState)
 start (Just (fp, cards)) gs = runBrickFlashcards =<< (gs `goToState`) <$> cardsWithOptionsState gs fp cards
 
 doImport :: ImportOpts -> IO ()
-doImport opts = do
+doImport opts' = do
+  let opts = opts' & optRowDelimiter %~ parseStringLiteral
   valOrExc <- try $ readFile (opts ^. optInput) :: IO (Either IOError String)
   case valOrExc of
     Left exc -> putStrLn (displayException exc)
     Right val -> do
-      let mCards = parseImportInput (opts ^. optImportType) (opts ^. optImportReverse) val
+      let mCards = parseImportInput opts val
       case mCards of
-        Just cards -> do
+        Right cards -> do
           writeFile (opts ^. optOutput) . cardsToString $ cards
           putStrLn "Successfully converted the file."
-        Nothing -> putStrLn "Failed the conversion."
-         
+        Left msg -> putStrLn msg
+         
+parseStringLiteral :: String -> String
+parseStringLiteral s = case parse (many charLiteral) "" s of
+  Left errorBundle -> error (errorBundlePretty (errorBundle :: ParseErrorBundle String Void))
+  Right result -> result

src/Import.hs

@@ -1,12 +1,30 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Import where
+import Control.Monad (void)
 import Data.Char (toLower, isSpace)
 import Data.List
-import Data.List.Split
+-- 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
+  { _optInput            :: String 
+  , _optOutput           :: String
+  , _optImportType       :: ImportType
+  , _optImportReverse    :: Bool
+  , _optRowDelimiter     :: String
+  , _optTermDefDelimiter :: String
+  , _optDefDelimiter     :: Maybe String }
+
+makeLenses ''ImportOpts
+
 instance Read ImportType where
   readsPrec _ input =
     case map toLower input of
@@ -15,14 +33,56 @@ instance Read ImportType where
          | "definition" `isPrefixOf` xs -> [(Def, drop 10 xs)]
          | otherwise -> []
 
-parseImportInput :: ImportType -> Bool -> String -> Maybe [Card]
-parseImportInput iType reverse input = 
-  let listToTuple [q, a] = Just $ if not reverse then (q, a) else (a, q)
-      listToTuple _ = Nothing
-      xs = mapM (listToTuple . splitOn "\t") (lines input)
-      makeOpen (header, body) = OpenQuestion header Nothing
-        (P "" (NE.fromList (map (dropWhile isSpace) (splitOneOf ",/;" body))) (Normal ""))
+type Parser = Parsec Void String
 
-  in case iType of
-    Def  -> map (\(s1, s2) -> Definition s1 Nothing s2) <$> xs
-    Open -> map makeOpen <$> xs 
+rowDelimiter :: String
+rowDelimiter = "\n\n"
+
+termDefDelimiter :: String
+termDefDelimiter = "\t"
+
+defDelimiter :: String
+defDelimiter = ","
+
+parseImportInput :: ImportOpts -> String -> Either String [Card]
+parseImportInput opts s = case parse (pImportInput opts) "failed import parsing" s of
+  Left parseErrorBundle -> Left $ errorBundlePretty (parseErrorBundle :: ParseErrorBundle String Void)
+  Right cards -> Right cards
+
+pImportInput :: ImportOpts -> Parser [Card]
+pImportInput opts = pRow opts `sepEndBy1` (void (try (pRowDelimiter *> eol)) <|> void pRowDelimiter <|> void (many eol) <|> eof)
+  where pRowDelimiter = string (opts ^. optRowDelimiter)
+
+pRow :: ImportOpts -> Parser Card
+pRow opts =
+  let
+    pTermDefDelimiter = string (opts ^. optTermDefDelimiter)
+    pDefDelimiter = string <$> (opts ^. optDefDelimiter)
+    pTerm = manyTill anySingle . lookAhead . try $ pSpecial opts
+    pDefs = maybe (fmap (:[]) (pDef opts)) (pDef opts `sepBy`) pDefDelimiter
+    defBeforeTerm = opts ^. optImportReverse
+  in do
+    (term, defs) <- if defBeforeTerm 
+      then do
+        defs' <- pDefs
+        pTermDefDelimiter
+        term' <- pTerm
+        return (term', defs')
+      else do
+        term' <- pTerm
+        pTermDefDelimiter
+        defs' <- pDefs
+        return (term', defs')
+
+    return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))
+
+pDef :: ImportOpts -> Parser String
+pDef opts = maybe
+  (manyTill anySingle . lookAhead . try $ pSpecial opts)
+  (\pDefDelimiter -> manyTill anySingle . lookAhead . try $ void pDefDelimiter <|> pSpecial opts)
+  (string <$> (opts ^. optDefDelimiter))
+
+pSpecial :: ImportOpts -> Parser ()
+pSpecial opts = void pTermDefDelimiter <|> void pRowDelimiter <|> (eol *> eof) <> eof
+  where pTermDefDelimiter = string (opts ^. optTermDefDelimiter)
+        pRowDelimiter = string (opts ^. optRowDelimiter)

src/UI.hs

@@ -8,6 +8,7 @@ module UI
 , Card
 , External
 , ImportType(..)
+, ImportOpts(..)
 , Parameters(..)
 
 , goToState