{-# LANGUAGE NamedFieldPuns #-}

{-# LANGUAGE RecordWildCards #-}

    readRecord,

import Control.Applicative

import Data.Bifunctor

import Control.Monad.State

import Text.Read (readMaybe)

import GHC.Natural

import Data.Attoparsec.Text

import Refined.Unsafe

import Deck.Category

data ReadError = IllegalFormat | RefineError !RefineException deriving (Show)

data ReadError
    = IllegalFormat
    | ParseFailure Text
    | RefineError !RefineException
    deriving (Show)
type RecordParser = StateT CategoryName Parser
data Record = Record
    { recordName :: CardName
    , recordCopies :: PositiveNumber
    , recordCategory :: CategoryName
    }
    deriving (Show)
cardNameP :: Parser CardName
cardNameP = do
    ch <- anyChar
    remaining <- T.pack <$> manyTill anyChar (endOfLine <|> endOfInput)
    return . NonEmptyText . reallyUnsafeRefine $ T.cons ch remaining
copiesP :: Parser Copies
copiesP = do
    num <- decimal
    if num == 0
        then fail "not a positive number"
        else return . PositiveNumber . reallyUnsafeRefine $ num
recordP :: CategoryName -> Parser Record
recordP recordCategory = do
    recordCopies <- copiesP
    void $ optional $ char 'x'
    skipSpace
    recordName <- cardNameP
    return $ Record {recordName, recordCopies, recordCategory}

readRecord :: Text -> Either [ReadError] (CardName, Copies)
readRecord input =
    let toError (l, r) = case l of
            Nothing -> Left $ singleton IllegalFormat
            Just x -> Right (x, r)
        refined :: (Predicate p a) => a -> Either ReadError (Refined p a)
        refined = mapLeft RefineError . refine
        validate =
            arr (fmap PositiveNumber . refined) *** arr (fmap NonEmptyText . refined)
                >>> arr
                    ( \case
                        (Right x, Right y) -> Right (x, y)
                        (Left x, Left y) -> Left [x, y]
                        (Left x, _) -> Left $ singleton x
                        (_, Left x) -> Left $ singleton x
                    )
        toCard tup = (\(x, y) -> (y, x)) <$> validate tup
     in (toError . bimap (readMaybe @Natural) T.pack . word1 . T.unpack $ input)
            >>= toCard

decklistP :: RecordParser [Record]
decklistP = do
    mb <- lift $ manyTill (recordP mainboard) (endOfLine <|> endOfInput)
    lift skipSpace

windowsToLinuxNewLines :: Text -> Text
windowsToLinuxNewLines = T.replace "\r\n" "\n"

    sb <- lift $ manyTill (recordP sideboard) (endOfLine <|> endOfInput)
    return $ mb ++ sb

    let (mb, sb) =
            bimap
                (mapM (parseRecord mainboard) . T.lines)
                (mapM (parseRecord sideboard) . T.lines . T.stripStart)
                . T.breakOn "\n\n"
                $ windowsToLinuxNewLines content
     in liftA2 (++) mb sb
  where
    parseRecord cat = readRecord >=> \(c, q) -> return $ add c cat q

    let parsed =
            mapLeft (singleton . ParseFailure . T.pack) . flip parseOnly content $
                (evalStateT decklistP mainboard <* endOfInput)
     in map (\Record {..} -> add recordName recordCategory recordCopies) <$> parsed

        attoparsec,