{-# LANGUAGE OverloadedStrings #-}

module Language.Fiddle.Types where

import Data.Aeson
import Data.Maybe
import Data.Text (Text, pack, splitOn, unpack)
import Text.Parsec.Pos

data Comment = NormalComment Text | DocComment Text
  deriving (Show)

data SourceSpan = SourceSpan
  { sourceStart :: !SourcePos,
    sourceStop :: !SourcePos
  }
  deriving (Eq, Ord, Show)

data Commented a = Commented {comments :: ![Comment], unCommented :: !a}
  deriving (Show)

docComments :: Commented a -> Text
docComments =
  mconcat
    . mapMaybe
      ( \case
          (DocComment t) -> Just t
          _ -> Nothing
      )
    . comments

-- Helper to create the compressed span string
formatSpan :: SourceSpan -> String
formatSpan (SourceSpan ss se) =
  let sl = sourceLine ss
      sc = sourceColumn ss
      fname = sourceName ss
      el = sourceLine se
      ec = sourceColumn se
   in fname ++ ":" ++ show sl ++ ":" ++ show sc ++ "-" ++ show el ++ ":" ++ show ec

-- Helper to parse the compressed span string
parseSpan :: String -> Maybe (String, Int, Int, Int, Int)
parseSpan str = do
  let parts = map (splitOn ":") $ splitOn "-" (pack str)

  case parts of
    [[fname, sl, sc], [el, ec]] ->
      Just (unpack fname, read $ unpack sl, read $ unpack sc, read $ unpack el, read $ unpack ec)
    _ -> Nothing

-- ToJSON and FromJSON instances
instance ToJSON SourceSpan where
  toJSON srcSpan =
    object
      ["span" .= formatSpan srcSpan]

instance FromJSON SourceSpan where
  parseJSON = withObject "SourceSpan" $ \v -> do
    spanStr <- v .: "span"
    case parseSpan spanStr of
      Just (fname, sl, sc, el, ec) ->
        return $ SourceSpan (newPos fname sl sc) (newPos fname el ec)
      Nothing -> fail "Invalid span format"