module System.Directory.Watchman.WFilePath
    ( WFilePath(..)
    , toByteString
    ) where

import Data.ByteString (ByteString)

import System.Directory.Watchman.BSER.Parser

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

toByteString :: WFilePath -> ByteString
toByteString :: WFilePath -> ByteString
toByteString (WFilePath ByteString
p) = ByteString
p

instance FromBSER WFilePath where
    parseBSER :: BSERValue -> Parser WFilePath
parseBSER BSERValue
x = do
        ByteString
str <- BSERValue -> Parser ByteString
forall a. FromBSER a => BSERValue -> Parser a
parseBSER BSERValue
x
        WFilePath -> Parser WFilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> WFilePath
WFilePath ByteString
str)