content: {- Copyright 2013-2022 NGLess Authors
   - License: MIT -}
  {-# LANGUAGE CPP #-}
  
  module Data.GFF
      ( GffLine(..)
      , GffStrand(..)
      , readGffLine
  #if IS_BUILDING_TEST
      , _parseGffAttributes
      , _trimString
  #endif
      ) where
  
  import Control.Monad
  import Control.DeepSeq
  import           Control.Arrow (second)
  
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Char8 as B8
  import qualified Data.ByteString.Lex.Integral as I
  import qualified Data.ByteString.Lex.Fractional as F
  
  import NGLess.NGError
  
  data GffStrand = GffPosStrand | GffNegStrand | GffUnknownStrand | GffUnStranded
              deriving (Eq, Show, Enum)
  
  instance NFData GffStrand where
      rnf !_ = ()
  
  data GffLine = GffLine
              { gffSeqId :: !B.ByteString
              , gffSource :: !B.ByteString
              , gffType :: !B.ByteString
              , gffStart :: !Int
              , gffEnd :: !Int
              , gffScore :: !(Maybe Float)
              , gffStrand :: !GffStrand
              , gffPhase :: {-# UNPACK #-} !Int -- ^phase: use -1 to denote .
              , gffAttrs :: ![(B.ByteString, B.ByteString)]
              } deriving (Eq,Show)
  
  instance NFData GffLine where
      -- All but the score and attrs are bang annotated
      rnf GffLine{ gffScore = sc, gffAttrs = attrs } = rnf sc `seq` rnf attrs
  
  _parseGffAttributes :: B.ByteString -> [(B.ByteString, B.ByteString)]
  _parseGffAttributes = foldMap (\(a, b) -> zip (repeat a) (B8.split ',' b))
                          . map (second (B8.filter (/='\"') . B.tail))
                          . map (\x -> B8.break (== (checkAttrTag x)) x)
                          . map _trimString
                          . B8.split ';'
                          . removeLastDel
                          . _trimString
  
      where
          removeLastDel :: B8.ByteString -> B8.ByteString
          removeLastDel s
              | B.null s = s
              | otherwise = case B8.last s of
                  ';' -> B8.init s
                  _   -> s
  
  --Check if the atribution tag is '=' or ' '
  checkAttrTag :: B.ByteString -> Char
  checkAttrTag s = case B8.elemIndex '=' s of
      Nothing -> ' '
      _       -> '='
  
  -- remove ' ' from begining and end.
  _trimString :: B.ByteString -> B.ByteString
  _trimString = trimBeg . trimEnd
      where
          trimBeg = B8.dropWhile isSpace
          trimEnd = fst . B8.spanEnd isSpace
          isSpace = (== ' ')
  
  
  readGffLine :: B.ByteString -> Either NGError GffLine
  readGffLine line = case B8.split '\t' line of
          [tk0,tk1,tk2,tk3,tk4,tk5,tk6,tk7,tk8] ->
              GffLine
                  tk0 -- seq id
                  tk1 -- source
                  tk2 -- type
                  <$> intOrError "reading start" tk3 -- start
                  <*> intOrError "reading end" tk4 -- end
                  <*> score tk5 -- score
                  <*> strandOrError tk6
                  <*> phase tk7
                  <*> pure (_parseGffAttributes tk8)
          _ -> throwDataError ("unexpected line in GFF: " ++ show line)
      where
          parseOrError :: String -> (B.ByteString -> Maybe b) -> B.ByteString -> NGLess b
          parseOrError context p s = case p s of
                      Just v -> return v
                      Nothing -> throwDataError $ "Could not parse GFF line (" ++ context  ++ ", while parsing '" ++ B8.unpack s ++  "'): "++ show line
          intOrError :: String -> B.ByteString -> NGLess Int
          intOrError c = parseOrError c (liftM fst . I.readDecimal)
          floatOrError c = parseOrError c (liftM fst . (F.readSigned F.readDecimal))
  
          score :: B.ByteString -> NGLess (Maybe Float)
          score "." = return Nothing
          score v = Just <$> floatOrError "reading score" v
  
          phase :: B.ByteString -> NGLess Int
          phase "." = return (-1)
          phase r = intOrError "reading phase" r
          strandOrError :: B.ByteString -> NGLess GffStrand
          strandOrError s = case B8.uncons s of
              Just (s',_) -> parseStrand s'
              _ -> throwDataError "Could not parse GFF line (empty strand field)"
  
  parseStrand :: Char -> NGLess GffStrand
  parseStrand '.' = return GffUnStranded
  parseStrand '+' = return GffPosStrand
  parseStrand '-' = return GffNegStrand
  parseStrand '?' = return GffUnknownStrand
  parseStrand u = throwDataError $ "Parsing GFF line: unhandled value for strand ("++[u]++")"
  