{-# 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 :: forall a. Read a => ByteString -> a
read = forall a. Read a => String -> a
Prelude.read 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 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> ByteString -> ByteString
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (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 = forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser ByteString Int
p
    where
        p :: Parser ByteString Int
p = forall a. Integral a => Parser a
A.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany (Char -> Parser ByteString Char
A.char 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 :: forall t. ParseTime t => ByteString -> Maybe t
parseIso8601 = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
iso8601Format forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

formatIso8601 :: FormatTime t => t -> String
formatIso8601 :: forall t. FormatTime t => t -> String
formatIso8601 = 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 :: forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum = forall a. Parser a -> ByteString -> Maybe a
parseMaybe (forall a. Num a => Parser a -> Parser a
A.signed 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 :: forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac = forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser ByteString a
p
    where
        p :: Parser ByteString a
p = ByteString -> Parser ByteString
A.string ByteString
"nan" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Read a => String -> a
Prelude.read String
"NaN")
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"inf" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Read a => String -> a
Prelude.read String
"Infinity")
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"-inf" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Read a => String -> a
Prelude.read String
"-Infinity")
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 :: forall a. IsString a => 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 = forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser ByteString Bool
p
    where
        p :: Parser ByteString Bool
p = Char -> Parser ByteString Char
A.char Char
'1' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 = forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser ByteString Bool
p
    where
        p :: Parser ByteString Bool
p = Char -> Parser ByteString Char
A.char Char
'1' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"oneshot" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 :: forall a.
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') -> forall a. a -> Maybe a
Just (a
a, a
b, a
c')
        (Maybe a, Maybe a, Maybe 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 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Char -> Bool) -> ByteString -> ByteString
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (forall a. Eq a => a -> a -> Bool
== Char
':')

toAssocList :: [ByteString] -> [(ByteString, ByteString)]
toAssocList :: [ByteString] -> [(ByteString, ByteString)]
toAssocList = 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 = 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
Prelude.break forall {b}. (ByteString, b) -> Bool
isGroupHead [(ByteString, b)]
xs
      in
        ((ByteString, b)
xforall a. a -> [a] -> [a]
:[(ByteString, b)]
ys) forall a. a -> [a] -> [a]
: [(ByteString, b)] -> [[(ByteString, b)]]
go [(ByteString, b)]
zs

    isGroupHead :: (ByteString, b) -> Bool
isGroupHead = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
groupHeads) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser a
p ByteString
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
A.parseOnly (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput) ByteString
s