module Network.IPFS.Path.Types (Path (..)) where

import Data.Swagger (ToSchema (..))
import Servant

import           Network.IPFS.Prelude
import qualified Network.IPFS.Internal.UTF8 as UTF8

-- | CID path
--
-- Exmaple
--
-- > "QmcaHAFzUPRCRaUK12dC6YyhcqEEtdfg94XrPwgCxZ1ihD/myfile.txt"
newtype Path = Path { Path -> Text
unpath :: Text }
  deriving          ( Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq
                    , (forall x. Path -> Rep Path x)
-> (forall x. Rep Path x -> Path) -> Generic Path
forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic
                    , Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show
                    , Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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 :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord
                    )
  deriving newtype  ( String -> Path
(String -> Path) -> IsString Path
forall a. (String -> a) -> IsString a
fromString :: String -> Path
$cfromString :: String -> Path
IsString
                    , Path -> ByteString
Path -> Builder
Path -> Text
(Path -> Text)
-> (Path -> Builder)
-> (Path -> ByteString)
-> (Path -> Text)
-> ToHttpApiData Path
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Path -> Text
$ctoQueryParam :: Path -> Text
toHeader :: Path -> ByteString
$ctoHeader :: Path -> ByteString
toEncodedUrlPiece :: Path -> Builder
$ctoEncodedUrlPiece :: Path -> Builder
toUrlPiece :: Path -> Text
$ctoUrlPiece :: Path -> Text
ToHttpApiData
                    , Proxy Path -> Declare (Definitions Schema) NamedSchema
(Proxy Path -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Path
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy Path -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Path -> Declare (Definitions Schema) NamedSchema
ToSchema
                    )

instance MimeRender PlainText Path where
  mimeRender :: Proxy PlainText -> Path -> ByteString
mimeRender Proxy PlainText
_ = Text -> ByteString
UTF8.textToLazyBS (Text -> ByteString) -> (Path -> Text) -> Path -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
unpath

instance MimeRender OctetStream Path where
  mimeRender :: Proxy OctetStream -> Path -> ByteString
mimeRender Proxy OctetStream
_ = Text -> ByteString
UTF8.textToLazyBS (Text -> ByteString) -> (Path -> Text) -> Path -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
unpath