{-# LANGUAGE OverloadedStrings #-}

module System.Directory.Watchman.Clockspec
    ( Clockspec
    , ClockId(..)
    , renderClockspec
    , mkNamedCursor
    ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC8

import System.Directory.Watchman.BSER

newtype NamedCursor = NamedCursor ByteString
    deriving (Int -> NamedCursor -> ShowS
[NamedCursor] -> ShowS
NamedCursor -> String
(Int -> NamedCursor -> ShowS)
-> (NamedCursor -> String)
-> ([NamedCursor] -> ShowS)
-> Show NamedCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamedCursor] -> ShowS
$cshowList :: [NamedCursor] -> ShowS
show :: NamedCursor -> String
$cshow :: NamedCursor -> String
showsPrec :: Int -> NamedCursor -> ShowS
$cshowsPrec :: Int -> NamedCursor -> ShowS
Show, NamedCursor -> NamedCursor -> Bool
(NamedCursor -> NamedCursor -> Bool)
-> (NamedCursor -> NamedCursor -> Bool) -> Eq NamedCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NamedCursor -> NamedCursor -> Bool
$c/= :: NamedCursor -> NamedCursor -> Bool
== :: NamedCursor -> NamedCursor -> Bool
$c== :: NamedCursor -> NamedCursor -> Bool
Eq, Eq NamedCursor
Eq NamedCursor
-> (NamedCursor -> NamedCursor -> Ordering)
-> (NamedCursor -> NamedCursor -> Bool)
-> (NamedCursor -> NamedCursor -> Bool)
-> (NamedCursor -> NamedCursor -> Bool)
-> (NamedCursor -> NamedCursor -> Bool)
-> (NamedCursor -> NamedCursor -> NamedCursor)
-> (NamedCursor -> NamedCursor -> NamedCursor)
-> Ord NamedCursor
NamedCursor -> NamedCursor -> Bool
NamedCursor -> NamedCursor -> Ordering
NamedCursor -> NamedCursor -> NamedCursor
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NamedCursor -> NamedCursor -> NamedCursor
$cmin :: NamedCursor -> NamedCursor -> NamedCursor
max :: NamedCursor -> NamedCursor -> NamedCursor
$cmax :: NamedCursor -> NamedCursor -> NamedCursor
>= :: NamedCursor -> NamedCursor -> Bool
$c>= :: NamedCursor -> NamedCursor -> Bool
> :: NamedCursor -> NamedCursor -> Bool
$c> :: NamedCursor -> NamedCursor -> Bool
<= :: NamedCursor -> NamedCursor -> Bool
$c<= :: NamedCursor -> NamedCursor -> Bool
< :: NamedCursor -> NamedCursor -> Bool
$c< :: NamedCursor -> NamedCursor -> Bool
compare :: NamedCursor -> NamedCursor -> Ordering
$ccompare :: NamedCursor -> NamedCursor -> Ordering
$cp1Ord :: Eq NamedCursor
Ord)

mkNamedCursor :: ByteString -> NamedCursor
mkNamedCursor :: ByteString -> NamedCursor
mkNamedCursor ByteString
name
    | ByteString
"n:" ByteString -> ByteString -> Bool
`BC8.isPrefixOf` ByteString
name = ByteString -> NamedCursor
NamedCursor ByteString
name
    | Bool
otherwise = String -> NamedCursor
forall a. HasCallStack => String -> a
error String
"Named Cursor must begin with \"n:\""

newtype ClockId = ClockId ByteString
    deriving (Int -> ClockId -> ShowS
[ClockId] -> ShowS
ClockId -> String
(Int -> ClockId -> ShowS)
-> (ClockId -> String) -> ([ClockId] -> ShowS) -> Show ClockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockId] -> ShowS
$cshowList :: [ClockId] -> ShowS
show :: ClockId -> String
$cshow :: ClockId -> String
showsPrec :: Int -> ClockId -> ShowS
$cshowsPrec :: Int -> ClockId -> ShowS
Show, ClockId -> ClockId -> Bool
(ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool) -> Eq ClockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockId -> ClockId -> Bool
$c/= :: ClockId -> ClockId -> Bool
== :: ClockId -> ClockId -> Bool
$c== :: ClockId -> ClockId -> Bool
Eq, Eq ClockId
Eq ClockId
-> (ClockId -> ClockId -> Ordering)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> ClockId)
-> (ClockId -> ClockId -> ClockId)
-> Ord ClockId
ClockId -> ClockId -> Bool
ClockId -> ClockId -> Ordering
ClockId -> ClockId -> ClockId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClockId -> ClockId -> ClockId
$cmin :: ClockId -> ClockId -> ClockId
max :: ClockId -> ClockId -> ClockId
$cmax :: ClockId -> ClockId -> ClockId
>= :: ClockId -> ClockId -> Bool
$c>= :: ClockId -> ClockId -> Bool
> :: ClockId -> ClockId -> Bool
$c> :: ClockId -> ClockId -> Bool
<= :: ClockId -> ClockId -> Bool
$c<= :: ClockId -> ClockId -> Bool
< :: ClockId -> ClockId -> Bool
$c< :: ClockId -> ClockId -> Bool
compare :: ClockId -> ClockId -> Ordering
$ccompare :: ClockId -> ClockId -> Ordering
$cp1Ord :: Eq ClockId
Ord)

data Clockspec
    = Clockspec_Epoch Int -- TODO Should this not be Int64 or Double?
    | Clockspec_Cursor NamedCursor
    | Clockspec_ClockId ClockId
    deriving (Int -> Clockspec -> ShowS
[Clockspec] -> ShowS
Clockspec -> String
(Int -> Clockspec -> ShowS)
-> (Clockspec -> String)
-> ([Clockspec] -> ShowS)
-> Show Clockspec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clockspec] -> ShowS
$cshowList :: [Clockspec] -> ShowS
show :: Clockspec -> String
$cshow :: Clockspec -> String
showsPrec :: Int -> Clockspec -> ShowS
$cshowsPrec :: Int -> Clockspec -> ShowS
Show, Clockspec -> Clockspec -> Bool
(Clockspec -> Clockspec -> Bool)
-> (Clockspec -> Clockspec -> Bool) -> Eq Clockspec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Clockspec -> Clockspec -> Bool
$c/= :: Clockspec -> Clockspec -> Bool
== :: Clockspec -> Clockspec -> Bool
$c== :: Clockspec -> Clockspec -> Bool
Eq, Eq Clockspec
Eq Clockspec
-> (Clockspec -> Clockspec -> Ordering)
-> (Clockspec -> Clockspec -> Bool)
-> (Clockspec -> Clockspec -> Bool)
-> (Clockspec -> Clockspec -> Bool)
-> (Clockspec -> Clockspec -> Bool)
-> (Clockspec -> Clockspec -> Clockspec)
-> (Clockspec -> Clockspec -> Clockspec)
-> Ord Clockspec
Clockspec -> Clockspec -> Bool
Clockspec -> Clockspec -> Ordering
Clockspec -> Clockspec -> Clockspec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Clockspec -> Clockspec -> Clockspec
$cmin :: Clockspec -> Clockspec -> Clockspec
max :: Clockspec -> Clockspec -> Clockspec
$cmax :: Clockspec -> Clockspec -> Clockspec
>= :: Clockspec -> Clockspec -> Bool
$c>= :: Clockspec -> Clockspec -> Bool
> :: Clockspec -> Clockspec -> Bool
$c> :: Clockspec -> Clockspec -> Bool
<= :: Clockspec -> Clockspec -> Bool
$c<= :: Clockspec -> Clockspec -> Bool
< :: Clockspec -> Clockspec -> Bool
$c< :: Clockspec -> Clockspec -> Bool
compare :: Clockspec -> Clockspec -> Ordering
$ccompare :: Clockspec -> Clockspec -> Ordering
$cp1Ord :: Eq Clockspec
Ord)

renderClockspec :: Clockspec -> BSERValue
renderClockspec :: Clockspec -> BSERValue
renderClockspec (Clockspec_Epoch Int
n) = Int -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt Int
n
renderClockspec (Clockspec_Cursor (NamedCursor ByteString
s)) = ByteString -> BSERValue
BSERString ByteString
s
renderClockspec (Clockspec_ClockId (ClockId ByteString
s)) = ByteString -> BSERValue
BSERString ByteString
s