{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Monatone.Types
  ( ParseError(..)
  , Parser
  , readInt
  , readText
  , formatError  -- Export error formatter
  ) where

import Control.Monad.Except (ExceptT)
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import GHC.Generics (Generic)

-- | Parser errors with detailed context
-- 
-- These errors provide enough information for debugging without
-- exposing internal implementation details to end users.
data ParseError 
  = UnsupportedFormat Text        -- ^ File format not supported (with format details)
  | CorruptedFile Text            -- ^ File structure invalid (with corruption details)
  | IOError Text                  -- ^ IO operation failed (with system error)
  | PartialParse Text             -- ^ File partially parsed (common with corrupted MP3s)
  | InvalidEncoding Text          -- ^ Text encoding issues (common with old MP3 tags) 
  deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, (forall x. ParseError -> Rep ParseError x)
-> (forall x. Rep ParseError x -> ParseError) -> Generic ParseError
forall x. Rep ParseError x -> ParseError
forall x. ParseError -> Rep ParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseError -> Rep ParseError x
from :: forall x. ParseError -> Rep ParseError x
$cto :: forall x. Rep ParseError x -> ParseError
to :: forall x. Rep ParseError x -> ParseError
Generic)

-- | Format error for user display
formatError :: ParseError -> Text
formatError :: ParseError -> Text
formatError (UnsupportedFormat Text
detail) = Text
"Unsupported format: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
formatError (CorruptedFile Text
detail) = Text
"Corrupted file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail  
formatError (IOError Text
detail) = Text
"IO error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
formatError (PartialParse Text
detail) = Text
"Warning: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (partial data recovered)"
formatError (InvalidEncoding Text
detail) = Text
"Encoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail

-- | Parser monad
type Parser = ExceptT ParseError IO

-- | Helper: Parse integer from text
readInt :: Text -> Maybe Int
readInt :: Text -> Maybe Int
readInt Text
s = case ReadS Int
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
s) of
  [(Int
x, String
"")] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  [(Int, String)]
_ -> Maybe Int
forall a. Maybe a
Nothing

-- | Helper: Parse text with UTF-8 decoding
readText :: ByteString -> Maybe Text
readText :: ByteString -> Maybe Text
readText ByteString
bs = case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs of
  Left UnicodeException
_ -> Maybe Text
forall a. Maybe a
Nothing
  Right Text
txt -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt