{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Dedicated module for orphan instances.
module Data.CAS.StoreOrphans where

import Data.CAS.ContentHashable
import Data.Functor.Contravariant
import Data.Store as Store
import qualified Path as Path
import qualified Path.Internal

instance Store (Path.Path Path.Abs Path.File) where
  size :: Size (Path Abs File)
size = (Path Abs File -> FilePath)
-> Size FilePath -> Size (Path Abs File)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(Path.Internal.Path FilePath
fp) -> FilePath
fp) Size FilePath
forall a. Store a => Size a
Store.size
  peek :: Peek (Path Abs File)
peek = FilePath -> Path Abs File
forall b t. FilePath -> Path b t
Path.Internal.Path (FilePath -> Path Abs File)
-> Peek FilePath -> Peek (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek FilePath
forall a. Store a => Peek a
Store.peek
  poke :: Path Abs File -> Poke ()
poke = FilePath -> Poke ()
forall a. Store a => a -> Poke ()
Store.poke (FilePath -> Poke ())
-> (Path Abs File -> FilePath) -> Path Abs File -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Path.Internal.Path FilePath
fp) -> FilePath
fp)

instance Store (Path.Path Path.Abs Path.Dir) where
  size :: Size (Path Abs Dir)
size = (Path Abs Dir -> FilePath) -> Size FilePath -> Size (Path Abs Dir)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(Path.Internal.Path FilePath
fp) -> FilePath
fp) Size FilePath
forall a. Store a => Size a
Store.size
  peek :: Peek (Path Abs Dir)
peek = FilePath -> Path Abs Dir
forall b t. FilePath -> Path b t
Path.Internal.Path (FilePath -> Path Abs Dir) -> Peek FilePath -> Peek (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek FilePath
forall a. Store a => Peek a
Store.peek
  poke :: Path Abs Dir -> Poke ()
poke = FilePath -> Poke ()
forall a. Store a => a -> Poke ()
Store.poke (FilePath -> Poke ())
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Path.Internal.Path FilePath
fp) -> FilePath
fp)

instance Store (Path.Path Path.Rel Path.File) where
  size :: Size (Path Rel File)
size = (Path Rel File -> FilePath)
-> Size FilePath -> Size (Path Rel File)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(Path.Internal.Path FilePath
fp) -> FilePath
fp) Size FilePath
forall a. Store a => Size a
Store.size
  peek :: Peek (Path Rel File)
peek = FilePath -> Path Rel File
forall b t. FilePath -> Path b t
Path.Internal.Path (FilePath -> Path Rel File)
-> Peek FilePath -> Peek (Path Rel File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek FilePath
forall a. Store a => Peek a
Store.peek
  poke :: Path Rel File -> Poke ()
poke = FilePath -> Poke ()
forall a. Store a => a -> Poke ()
Store.poke (FilePath -> Poke ())
-> (Path Rel File -> FilePath) -> Path Rel File -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Path.Internal.Path FilePath
fp) -> FilePath
fp)

instance Store (Path.Path Path.Rel Path.Dir) where
  size :: Size (Path Rel Dir)
size = (Path Rel Dir -> FilePath) -> Size FilePath -> Size (Path Rel Dir)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(Path.Internal.Path FilePath
fp) -> FilePath
fp) Size FilePath
forall a. Store a => Size a
Store.size
  peek :: Peek (Path Rel Dir)
peek = FilePath -> Path Rel Dir
forall b t. FilePath -> Path b t
Path.Internal.Path (FilePath -> Path Rel Dir) -> Peek FilePath -> Peek (Path Rel Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek FilePath
forall a. Store a => Peek a
Store.peek
  poke :: Path Rel Dir -> Poke ()
poke = FilePath -> Poke ()
forall a. Store a => a -> Poke ()
Store.poke (FilePath -> Poke ())
-> (Path Rel Dir -> FilePath) -> Path Rel Dir -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Path.Internal.Path FilePath
fp) -> FilePath
fp)

instance Store ContentHash where
  size :: Size ContentHash
size = (ContentHash -> ByteString) -> Size ByteString -> Size ContentHash
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ContentHash -> ByteString
toBytes Size ByteString
forall a. Store a => Size a
size
  peek :: Peek ContentHash
peek =
    ByteString -> Maybe ContentHash
fromBytes (ByteString -> Maybe ContentHash)
-> Peek ByteString -> Peek (Maybe ContentHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek ByteString
forall a. Store a => Peek a
peek Peek (Maybe ContentHash)
-> (Maybe ContentHash -> Peek ContentHash) -> Peek ContentHash
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe ContentHash
Nothing -> Text -> Peek ContentHash
forall a. Text -> Peek a
peekException Text
"Store ContentHash: Illegal digest"
      Just ContentHash
x -> ContentHash -> Peek ContentHash
forall (m :: * -> *) a. Monad m => a -> m a
return ContentHash
x
  poke :: ContentHash -> Poke ()
poke = ByteString -> Poke ()
forall a. Store a => a -> Poke ()
poke (ByteString -> Poke ())
-> (ContentHash -> ByteString) -> ContentHash -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentHash -> ByteString
toBytes

instance Store ExternallyAssuredFile

instance Store ExternallyAssuredDirectory