{-# LANGUAGE OverloadedStrings #-}
-- | Module    : Network.MPD.Util
-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010
-- License     : MIT (see LICENSE)
-- Maintainer  : Joachim Fasting <joachifm@fastmail.fm>
-- Stability   : alpha
--
-- Utilities.

module Network.MPD.Util (
    parseDate, parseIso8601, formatIso8601, parseNum, parseFrac,
    parseBool, parseSingle, showBool, breakChar, parseTriple,
    toAssoc, toAssocList, splitGroups, read
    ) where

import           Control.Arrow

import           Data.Time.Format (ParseTime, parseTimeM, FormatTime, formatTime)

import           Data.Time.Format (defaultTimeLocale)

import qualified Prelude
import           Prelude hiding        (break, take, drop, dropWhile, read)
import           Data.ByteString.Char8 (break, drop, dropWhile, ByteString)
import qualified Data.ByteString.UTF8 as UTF8
import           Data.String

import           Control.Applicative
import qualified Data.Attoparsec.ByteString.Char8 as A

-- | Like Prelude.read, but works with ByteString.
read :: Read a => ByteString -> a
read :: ByteString -> a
read = String -> a
forall a. Read a => String -> a
Prelude.read (String -> a) -> (ByteString -> String) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

-- Break a string by character, removing the separator.
breakChar :: Char -> ByteString -> (ByteString, ByteString)
breakChar :: Char -> ByteString -> (ByteString, ByteString)
breakChar Char
c = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> ByteString -> ByteString
drop Int
1) ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

-- Parse a date value.
-- > parseDate "2008" = Just 2008
-- > parseDate "2008-03-01" = Just 2008
parseDate :: ByteString -> Maybe Int
parseDate :: ByteString -> Maybe Int
parseDate = Parser Int -> ByteString -> Maybe Int
forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser Int
p
    where
        p :: Parser Int
p = Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser ByteString () -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany (Char -> Parser ByteString Char
A.char Char
'-' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Char
A.digit)

-- Parse date in iso 8601 format
parseIso8601 :: (ParseTime t) => ByteString -> Maybe t
parseIso8601 :: ByteString -> Maybe t
parseIso8601 = Bool -> TimeLocale -> String -> String -> Maybe t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
iso8601Format (String -> Maybe t)
-> (ByteString -> String) -> ByteString -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

formatIso8601 :: FormatTime t => t -> String
formatIso8601 :: t -> String
formatIso8601 = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
iso8601Format

iso8601Format :: String
iso8601Format :: String
iso8601Format = String
"%FT%TZ"

-- Parse a positive or negative integer value, returning 'Nothing' on failure.
parseNum :: (Read a, Integral a) => ByteString -> Maybe a
parseNum :: ByteString -> Maybe a
parseNum = Parser a -> ByteString -> Maybe a
forall a. Parser a -> ByteString -> Maybe a
parseMaybe (Parser a -> Parser a
forall a. Num a => Parser a -> Parser a
A.signed Parser a
forall a. Integral a => Parser a
A.decimal)

-- Parse C style floating point value, returning 'Nothing' on failure.
parseFrac :: (Fractional a, Read a) => ByteString -> Maybe a
parseFrac :: ByteString -> Maybe a
parseFrac = Parser a -> ByteString -> Maybe a
forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser a
p
    where
        p :: Parser a
p = ByteString -> Parser ByteString
A.string ByteString
"nan" Parser ByteString -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> a
forall a. Read a => String -> a
Prelude.read String
"NaN")
            Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"inf" Parser ByteString -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> a
forall a. Read a => String -> a
Prelude.read String
"Infinity")
            Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"-inf" Parser ByteString -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> a
forall a. Read a => String -> a
Prelude.read String
"-Infinity")
            Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
forall a. Fractional a => Parser a
A.rational

-- Inverts 'parseBool'.
showBool :: IsString a => Bool -> a
-- FIXME: can we change the type to (Bool -> ByteString)?
--        not without also changing Arg to use bytestrings rather than plain String.
showBool :: Bool -> a
showBool Bool
x = if Bool
x then a
"1" else a
"0"

-- Parse a boolean response value.
parseBool :: ByteString -> Maybe Bool
parseBool :: ByteString -> Maybe Bool
parseBool = Parser Bool -> ByteString -> Maybe Bool
forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser Bool
p
    where
        p :: Parser Bool
p = Char -> Parser ByteString Char
A.char Char
'1' Parser ByteString Char -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'0' Parser ByteString Char -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- Parse a boolean response value.
parseSingle :: ByteString -> Maybe Bool
parseSingle :: ByteString -> Maybe Bool
parseSingle = Parser Bool -> ByteString -> Maybe Bool
forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser Bool
p
    where
        p :: Parser Bool
p = Char -> Parser ByteString Char
A.char Char
'1' Parser ByteString Char -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'0' Parser ByteString Char -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"oneshot" Parser ByteString -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- Break a string into triple.
parseTriple :: Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple :: Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple Char
c ByteString -> Maybe a
f ByteString
s = let (ByteString
u, ByteString
u') = Char -> ByteString -> (ByteString, ByteString)
breakChar Char
c ByteString
s
                        (ByteString
v, ByteString
w)  = Char -> ByteString -> (ByteString, ByteString)
breakChar Char
c ByteString
u' in
    case (ByteString -> Maybe a
f ByteString
u, ByteString -> Maybe a
f ByteString
v, ByteString -> Maybe a
f ByteString
w) of
        (Just a
a, Just a
b, Just a
c') -> (a, a, a) -> Maybe (a, a, a)
forall a. a -> Maybe a
Just (a
a, a
b, a
c')
        (Maybe a, Maybe a, Maybe a)
_                        -> Maybe (a, a, a)
forall a. Maybe a
Nothing

-- Break a string into a key-value pair, separating at the first ':'.
toAssoc :: ByteString -> (ByteString, ByteString)
toAssoc :: ByteString -> (ByteString, ByteString)
toAssoc = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Char -> Bool) -> ByteString -> ByteString
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
drop Int
1) ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')

toAssocList :: [ByteString] -> [(ByteString, ByteString)]
toAssocList :: [ByteString] -> [(ByteString, ByteString)]
toAssocList = (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, ByteString)
toAssoc

-- Takes an association list with recurring keys and groups each cycle of keys
-- with their values together.  There can be several keys that begin cycles,
-- (the elements of the first parameter).
splitGroups :: [ByteString] -> [(ByteString, ByteString)] -> [[(ByteString, ByteString)]]
splitGroups :: [ByteString]
-> [(ByteString, ByteString)] -> [[(ByteString, ByteString)]]
splitGroups [ByteString]
groupHeads = [(ByteString, ByteString)] -> [[(ByteString, ByteString)]]
forall b. [(ByteString, b)] -> [[(ByteString, b)]]
go
  where
    go :: [(ByteString, b)] -> [[(ByteString, b)]]
go []     = []
    go ((ByteString, b)
x:[(ByteString, b)]
xs) =
      let
        ([(ByteString, b)]
ys, [(ByteString, b)]
zs) = ((ByteString, b) -> Bool)
-> [(ByteString, b)] -> ([(ByteString, b)], [(ByteString, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Prelude.break (ByteString, b) -> Bool
forall b. (ByteString, b) -> Bool
isGroupHead [(ByteString, b)]
xs
      in
        ((ByteString, b)
x(ByteString, b) -> [(ByteString, b)] -> [(ByteString, b)]
forall a. a -> [a] -> [a]
:[(ByteString, b)]
ys) [(ByteString, b)] -> [[(ByteString, b)]] -> [[(ByteString, b)]]
forall a. a -> [a] -> [a]
: [(ByteString, b)] -> [[(ByteString, b)]]
go [(ByteString, b)]
zs

    isGroupHead :: (ByteString, b) -> Bool
isGroupHead = (ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
groupHeads) (ByteString -> Bool)
-> ((ByteString, b) -> ByteString) -> (ByteString, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, b) -> ByteString
forall a b. (a, b) -> a
fst

-- A helper for running a Parser, turning errors into Nothing.
parseMaybe :: A.Parser a -> ByteString -> Maybe a
parseMaybe :: Parser a -> ByteString -> Maybe a
parseMaybe Parser a
p ByteString
s = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Maybe a) -> Either String a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser a
p Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) ByteString
s