hascard-0.6.0.2: src/Import.hs

{-# 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
  { _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
      xs | "open"       `isPrefixOf` xs -> [(Open, drop 4 xs)]
         | "def"        `isPrefixOf` xs -> [(Def,  drop 3 xs)]
         | "definition" `isPrefixOf` xs -> [(Def, drop 10 xs)]
         | otherwise -> []

type Parser = Parsec Void String

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
    case (defBeforeTerm, opts ^. optImportType) of
      (False, Open) -> do
        term <- pTerm
        pTermDefDelimiter
        defs <- pDefs
        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))
      (True, Open) -> do
        defs <- pDefs
        pTermDefDelimiter
        term <- pTerm
        return $ OpenQuestion (filter (/= '\n') term) Nothing (P "" (NE.fromList (map (dropWhile isSpace) defs)) (Normal ""))
      (False, Def) -> do
        term <- pTerm
        pTermDefDelimiter
        def <- pDef opts
        return $ Definition (filter (/= '\n') term) Nothing def
      (True, Def) -> do
        def <- pDef opts
        pTermDefDelimiter
        term <- pTerm
        return $ Definition (filter (/= '\n') term) Nothing def

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)