{-# LANGUAGE TemplateHaskell #-}
module Export where

import Lens.Micro.Platform
import qualified Data.List.NonEmpty as NE
import Types
import Data.Either.Extra (mapRight)
import Data.List.Extra (replace)
import Data.List (intercalate, stripPrefix, tails, isPrefixOf)

data ExportOpts = ExportOpts
  { ExportOpts -> [Char]
_optExportInput       :: String 
  , ExportOpts -> [Char]
_optExportOutput      :: String
  , ExportOpts -> [Char]
_optCardDelimiter     :: String 
  , ExportOpts -> [Char]
_optQuestionDelimiter :: String 
  }

makeLenses ''ExportOpts

exportCards :: ExportOpts -> [Card] -> Either String String
exportCards :: ExportOpts -> [Card] -> Either [Char] [Char]
exportCards ExportOpts
opts = forall b c a. (b -> c) -> Either a b -> Either a c
mapRight (forall a. [a] -> [[a]] -> [a]
intercalate (ExportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ExportOpts [Char]
optCardDelimiter)) 
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ExportOpts -> Card -> Either [Char] [Char]
exportCard ExportOpts
opts)

exportCard :: ExportOpts -> Card -> Either String String
exportCard :: ExportOpts -> Card -> Either [Char] [Char]
exportCard ExportOpts
opts (Definition {question :: Card -> [Char]
question=[Char]
q, definition :: Card -> [Char]
definition=[Char]
d}) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
  ExportOpts -> [Char] -> [Char]
escape ExportOpts
opts [Char]
q forall a. Semigroup a => a -> a -> a
<> (ExportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ExportOpts [Char]
optQuestionDelimiter) forall a. Semigroup a => a -> a -> a
<> ExportOpts -> [Char] -> [Char]
escape ExportOpts
opts [Char]
d
exportCard ExportOpts
opts (OpenQuestion {question :: Card -> [Char]
question=[Char]
q, perforated :: Card -> Perforated
perforated=Perforated
p}) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
  ExportOpts -> [Char] -> [Char]
escape ExportOpts
opts [Char]
q forall a. Semigroup a => a -> a -> a
<> (ExportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ExportOpts [Char]
optQuestionDelimiter) forall a. Semigroup a => a -> a -> a
<> ExportOpts -> [Char] -> [Char]
escape ExportOpts
opts (Perforated -> [Char]
fillPerforated Perforated
p)
exportCard ExportOpts
_ Card
_ = forall a b. a -> Either a b
Left [Char]
"Only definition and open question cards can be exported."

fillPerforated :: Perforated -> String
fillPerforated :: Perforated -> [Char]
fillPerforated = forall a.
([Char] -> a)
-> ([Char] -> NonEmpty [Char] -> a -> a) -> Sentence -> a
foldSentence forall a. a -> a
id [Char] -> NonEmpty [Char] -> [Char] -> [Char]
fSent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perforated -> Sentence
perforatedToSentence
  where fSent :: [Char] -> NonEmpty [Char] -> [Char] -> [Char]
fSent [Char]
pre NonEmpty [Char]
gaps [Char]
post = [Char]
pre forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse [Char]
"/" NonEmpty [Char]
gaps) forall a. Semigroup a => a -> a -> a
<> [Char]
post

escape :: ExportOpts -> String -> String
escape :: ExportOpts -> [Char] -> [Char]
escape ExportOpts
opts [Char]
s = if [Char]
s forall a. Eq a => [a] -> [a] -> Bool
`contains` (ExportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ExportOpts [Char]
optCardDelimiter) Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => [a] -> [a] -> Bool
`contains` (ExportOpts
opts forall s a. s -> Getting a s a -> a
^. Lens' ExportOpts [Char]
optQuestionDelimiter)
  then [Char]
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [Char]
"\"" [Char]
"\"\"" [Char]
s forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
  else [Char]
s

contains :: Eq a => [a] -> [a] -> Bool
contains :: forall a. Eq a => [a] -> [a] -> Bool
contains [a]
str [a]
substr = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
substr) (forall a. [a] -> [[a]]
tails [a]
str)