-----------------------------------------------------------------------------
-- |
-- Module      :  Data.BEncode.Lexer
-- Copyright   :  (c) 2005 Jesper Louis Andersen <jlouis@mongers.org>
--                    2006 Lemmih <lemmih@gmail.com>
-- License     :  BSD3
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  believed to be stable
-- Portability :  portable
-----------------------------------------------------------------------------
module Data.BEncode.Lexer where

import Data.Char

import qualified Data.ByteString.Lazy.Char8 as L

data Token
    = TDict
    | TList
    | TInt
    | TString L.ByteString
    | TNumber Integer
    | TEnd
      deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show,Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq)


lexer :: L.ByteString -> [Token]
lexer :: ByteString -> [Token]
lexer fs :: ByteString
fs | ByteString -> Bool
L.null ByteString
fs = []
lexer fs :: ByteString
fs
    = case Char
ch of
        'd' -> Token
TDict Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest
        'l' -> Token
TList Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest
        'i' -> Token
TInt  Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest
        'e' -> Token
TEnd  Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest
        '-' -> let (digits :: ByteString
digits,rest' :: ByteString
rest') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
L.span Char -> Bool
isDigit ByteString
rest
                   number :: Integer
number = String -> Integer
forall a. Read a => String -> a
read (ByteString -> String
L.unpack ByteString
digits)
               in Integer -> Token
TNumber (-Integer
number) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest'
        _ | Char -> Bool
isDigit Char
ch
              -> let (digits :: ByteString
digits,rest' :: ByteString
rest') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
L.span Char -> Bool
isDigit ByteString
fs
                     number :: Integer
number = String -> Integer
forall a. Read a => String -> a
read (ByteString -> String
L.unpack ByteString
digits)
                 in if ByteString -> Bool
L.null ByteString
rest'
                       then [Integer -> Token
TNumber Integer
number]
                       else case ByteString -> Char
L.head ByteString
rest' of
                              ':' -> let (str :: ByteString
str, rest'' :: ByteString
rest'') = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
number) (ByteString -> ByteString
L.tail ByteString
rest')
                                     in ByteString -> Token
TString ByteString
str Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest''
                              _ -> Integer -> Token
TNumber Integer
number Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ByteString -> [Token]
lexer ByteString
rest'
          | Bool
otherwise -> String -> [Token]
forall a. HasCallStack => String -> a
error "Lexer error."
    where ch :: Char
ch = ByteString -> Char
L.head ByteString
fs
          rest :: ByteString
rest = ByteString -> ByteString
L.tail ByteString
fs