module Passman.Core.Entry
(
Entry (..)
, load
, textToEntry
, csvToEntry
, save
, append
, entryToText
, entryToCsv
) where
import Control.Monad.Trans.Resource (MonadResource, MonadThrow,
throwM)
import Control.Monad (mfilter)
import Data.Conduit (ConduitM, (.|))
import qualified Data.Conduit.List as C
import Data.Conduit.Binary (sourceFile, sinkFile, sinkIOHandle)
import Data.Conduit.Text (decodeUtf8, encodeUtf8)
import Data.CSV.Conduit (intoCSV, fromCSV, defCSVSettings)
import Numeric.Natural (Natural)
import Text.Read (readMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import System.IO (IOMode (AppendMode), openBinaryFile)
import Passman.Core.Mode (Mode, readMode, defaultMode, characterCode)
import Passman.Core.Info (Info (Info), fromInfo)
data Entry = Entry
{
info :: Info
, maxLength :: Natural
, mode :: Mode
}
deriving (Show, Eq)
load :: MonadResource m => FilePath -> ConduitM i Entry m ()
load f = sourceFile f .| decodeUtf8 .| textToEntry
textToEntry :: MonadThrow m => ConduitM Text Entry m ()
textToEntry = intoCSV defCSVSettings .| C.mapM csvToEntry
csvToEntry :: MonadThrow m => [Text] -> m Entry
csvToEntry [] = failM "no info column"
csvToEntry [a] = pure $ Entry (Info a) 0 defaultMode
csvToEntry [a,b] = flip (Entry (Info a)) defaultMode <$> parseLength b
csvToEntry [a,b,c] = Entry (Info a) <$> parseLength b <*> parseMode c
csvToEntry _ = failM "too many columns"
save :: MonadResource m => FilePath -> ConduitM Entry o m ()
save f = entryToText .| encodeUtf8 .| sinkFile f
append :: MonadResource m => FilePath -> ConduitM Entry o m ()
append fp = entryToText .| encodeUtf8 .| sinkIOHandle
(openBinaryFile fp AppendMode)
entryToText :: Monad m => ConduitM Entry Text m ()
entryToText = C.map entryToCsv .| fromCSV defCSVSettings
entryToCsv :: Entry -> [Text]
entryToCsv (Entry i l m) =
[ fromInfo i
, if l == 0 then T.empty else T.pack $ show l
, T.pack $ characterCode m
]
parseLength :: MonadThrow m => Text -> m Natural
parseLength = parseOrError
(parseWithOrEmpty (mfilter (>0) . readMaybe . T.unpack) 0)
"invalid length"
parseMode :: MonadThrow m => Text -> m Mode
parseMode = parseOrError (parseWithOrEmpty (readMode . T.unpack) defaultMode)
"invalid mode"
parseWithOrEmpty :: (Text -> Maybe a) -> a -> Text -> Maybe a
parseWithOrEmpty p d x = if T.null x' then Just d else p x'
where
x' = T.strip x
parseOrError :: MonadThrow m => (a -> Maybe b) -> String -> a -> m b
parseOrError f err = maybe (failM err) pure . f
failM :: MonadThrow m => String -> m a
failM = throwM . userError