{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
-- | This module provides utilities which help ensure that we aren't
-- attempting to de-serialize data that is an older or newer version.
-- The 'WithVersion' utility wraps up a datatype along with a version
-- tag. This version tag can either be provided by the user
-- ('namedVersionConfig'), or use a computed hash
-- ('hashedVersionConfig').
--
-- The magic here is using an SYB traversal ('Data') to get the
-- structure of all the data-types involved. This info is rendered to
-- text and hashed to yield a hash which describes it.
--
-- NOTE that this API is still quite new and so is likely to break
-- compatibility in the future. It should also be expected that the
-- computed hashes may change between major version bumps, though this
-- will be minimized when directly feasible.
module Data.Store.Version
    ( StoreVersion(..)
    , VersionConfig(..)
    , hashedVersionConfig
    , namedVersionConfig
    , encodeWithVersionQ
    , decodeWithVersionQ
    ) where

import           Control.Monad
import           Control.Monad.Trans.State
import qualified Crypto.Hash.SHA1 as SHA1
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as B64Url
import qualified Data.ByteString.Char8 as BS8
import           Data.Generics hiding (DataType, Generic)
import qualified Data.Map as M
import qualified Data.Set as S
import           Data.Store.Internal
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With)
import           Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.IO as T
import           Data.Word (Word32)
import           GHC.Generics (Generic)
import           Language.Haskell.TH
import           System.Directory
import           System.Environment
import           System.FilePath
import           TH.RelativePaths
import           TH.Utilities

newtype StoreVersion = StoreVersion { StoreVersion -> ByteString
unStoreVersion :: BS.ByteString }
    deriving (StoreVersion -> StoreVersion -> Bool
(StoreVersion -> StoreVersion -> Bool)
-> (StoreVersion -> StoreVersion -> Bool) -> Eq StoreVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreVersion -> StoreVersion -> Bool
$c/= :: StoreVersion -> StoreVersion -> Bool
== :: StoreVersion -> StoreVersion -> Bool
$c== :: StoreVersion -> StoreVersion -> Bool
Eq, Int -> StoreVersion -> ShowS
[StoreVersion] -> ShowS
StoreVersion -> String
(Int -> StoreVersion -> ShowS)
-> (StoreVersion -> String)
-> ([StoreVersion] -> ShowS)
-> Show StoreVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreVersion] -> ShowS
$cshowList :: [StoreVersion] -> ShowS
show :: StoreVersion -> String
$cshow :: StoreVersion -> String
showsPrec :: Int -> StoreVersion -> ShowS
$cshowsPrec :: Int -> StoreVersion -> ShowS
Show, Eq StoreVersion
Eq StoreVersion
-> (StoreVersion -> StoreVersion -> Ordering)
-> (StoreVersion -> StoreVersion -> Bool)
-> (StoreVersion -> StoreVersion -> Bool)
-> (StoreVersion -> StoreVersion -> Bool)
-> (StoreVersion -> StoreVersion -> Bool)
-> (StoreVersion -> StoreVersion -> StoreVersion)
-> (StoreVersion -> StoreVersion -> StoreVersion)
-> Ord StoreVersion
StoreVersion -> StoreVersion -> Bool
StoreVersion -> StoreVersion -> Ordering
StoreVersion -> StoreVersion -> StoreVersion
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 :: StoreVersion -> StoreVersion -> StoreVersion
$cmin :: StoreVersion -> StoreVersion -> StoreVersion
max :: StoreVersion -> StoreVersion -> StoreVersion
$cmax :: StoreVersion -> StoreVersion -> StoreVersion
>= :: StoreVersion -> StoreVersion -> Bool
$c>= :: StoreVersion -> StoreVersion -> Bool
> :: StoreVersion -> StoreVersion -> Bool
$c> :: StoreVersion -> StoreVersion -> Bool
<= :: StoreVersion -> StoreVersion -> Bool
$c<= :: StoreVersion -> StoreVersion -> Bool
< :: StoreVersion -> StoreVersion -> Bool
$c< :: StoreVersion -> StoreVersion -> Bool
compare :: StoreVersion -> StoreVersion -> Ordering
$ccompare :: StoreVersion -> StoreVersion -> Ordering
$cp1Ord :: Eq StoreVersion
Ord, Typeable StoreVersion
DataType
Constr
Typeable StoreVersion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> StoreVersion -> c StoreVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StoreVersion)
-> (StoreVersion -> Constr)
-> (StoreVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StoreVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StoreVersion))
-> ((forall b. Data b => b -> b) -> StoreVersion -> StoreVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StoreVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StoreVersion -> r)
-> (forall u. (forall d. Data d => d -> u) -> StoreVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StoreVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion)
-> Data StoreVersion
StoreVersion -> DataType
StoreVersion -> Constr
(forall b. Data b => b -> b) -> StoreVersion -> StoreVersion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StoreVersion -> c StoreVersion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StoreVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StoreVersion -> u
forall u. (forall d. Data d => d -> u) -> StoreVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StoreVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StoreVersion -> c StoreVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StoreVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StoreVersion)
$cStoreVersion :: Constr
$tStoreVersion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
gmapMp :: (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
gmapM :: (forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StoreVersion -> m StoreVersion
gmapQi :: Int -> (forall d. Data d => d -> u) -> StoreVersion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StoreVersion -> u
gmapQ :: (forall d. Data d => d -> u) -> StoreVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StoreVersion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StoreVersion -> r
gmapT :: (forall b. Data b => b -> b) -> StoreVersion -> StoreVersion
$cgmapT :: (forall b. Data b => b -> b) -> StoreVersion -> StoreVersion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StoreVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StoreVersion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c StoreVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StoreVersion)
dataTypeOf :: StoreVersion -> DataType
$cdataTypeOf :: StoreVersion -> DataType
toConstr :: StoreVersion -> Constr
$ctoConstr :: StoreVersion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StoreVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StoreVersion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StoreVersion -> c StoreVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StoreVersion -> c StoreVersion
$cp1Data :: Typeable StoreVersion
Data, Typeable, (forall x. StoreVersion -> Rep StoreVersion x)
-> (forall x. Rep StoreVersion x -> StoreVersion)
-> Generic StoreVersion
forall x. Rep StoreVersion x -> StoreVersion
forall x. StoreVersion -> Rep StoreVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StoreVersion x -> StoreVersion
$cfrom :: forall x. StoreVersion -> Rep StoreVersion x
Generic, Peek StoreVersion
Size StoreVersion
Size StoreVersion
-> (StoreVersion -> Poke ())
-> Peek StoreVersion
-> Store StoreVersion
StoreVersion -> Poke ()
forall a. Size a -> (a -> Poke ()) -> Peek a -> Store a
peek :: Peek StoreVersion
$cpeek :: Peek StoreVersion
poke :: StoreVersion -> Poke ()
$cpoke :: StoreVersion -> Poke ()
size :: Size StoreVersion
$csize :: Size StoreVersion
Store)

-- | Configuration for the version checking of a particular type.
data VersionConfig a = VersionConfig
    { VersionConfig a -> Maybe String
vcExpectedHash :: Maybe String
      -- ^ When set, specifies the hash which is expected to be computed.
    , VersionConfig a -> Maybe String
vcManualName :: Maybe String
      -- ^ When set, specifies the name to instead use to tag the data.
    , VersionConfig a -> Set String
vcIgnore :: S.Set String
      -- ^ DataTypes to ignore.
    , VersionConfig a -> Map String String
vcRenames :: M.Map String String
      -- ^ Allowed renamings of datatypes, useful when they move.
    } deriving (VersionConfig a -> VersionConfig a -> Bool
(VersionConfig a -> VersionConfig a -> Bool)
-> (VersionConfig a -> VersionConfig a -> Bool)
-> Eq (VersionConfig a)
forall a. VersionConfig a -> VersionConfig a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionConfig a -> VersionConfig a -> Bool
$c/= :: forall a. VersionConfig a -> VersionConfig a -> Bool
== :: VersionConfig a -> VersionConfig a -> Bool
$c== :: forall a. VersionConfig a -> VersionConfig a -> Bool
Eq, Int -> VersionConfig a -> ShowS
[VersionConfig a] -> ShowS
VersionConfig a -> String
(Int -> VersionConfig a -> ShowS)
-> (VersionConfig a -> String)
-> ([VersionConfig a] -> ShowS)
-> Show (VersionConfig a)
forall a. Int -> VersionConfig a -> ShowS
forall a. [VersionConfig a] -> ShowS
forall a. VersionConfig a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionConfig a] -> ShowS
$cshowList :: forall a. [VersionConfig a] -> ShowS
show :: VersionConfig a -> String
$cshow :: forall a. VersionConfig a -> String
showsPrec :: Int -> VersionConfig a -> ShowS
$cshowsPrec :: forall a. Int -> VersionConfig a -> ShowS
Show, Typeable (VersionConfig a)
DataType
Constr
Typeable (VersionConfig a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (VersionConfig a))
-> (VersionConfig a -> Constr)
-> (VersionConfig a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (VersionConfig a)))
-> ((forall b. Data b => b -> b)
    -> VersionConfig a -> VersionConfig a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VersionConfig a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VersionConfig a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VersionConfig a -> m (VersionConfig a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VersionConfig a -> m (VersionConfig a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VersionConfig a -> m (VersionConfig a))
-> Data (VersionConfig a)
VersionConfig a -> DataType
VersionConfig a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a))
(forall b. Data b => b -> b) -> VersionConfig a -> VersionConfig a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VersionConfig a)
forall a. Data a => Typeable (VersionConfig a)
forall a. Data a => VersionConfig a -> DataType
forall a. Data a => VersionConfig a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> VersionConfig a -> VersionConfig a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> VersionConfig a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> VersionConfig a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VersionConfig a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (VersionConfig a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> VersionConfig a -> u
forall u. (forall d. Data d => d -> u) -> VersionConfig a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VersionConfig a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (VersionConfig a))
$cVersionConfig :: Constr
$tVersionConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
gmapMp :: (forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
gmapM :: (forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> VersionConfig a -> m (VersionConfig a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> VersionConfig a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> VersionConfig a -> u
gmapQ :: (forall d. Data d => d -> u) -> VersionConfig a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> VersionConfig a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionConfig a -> r
gmapT :: (forall b. Data b => b -> b) -> VersionConfig a -> VersionConfig a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> VersionConfig a -> VersionConfig a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (VersionConfig a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (VersionConfig a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (VersionConfig a))
dataTypeOf :: VersionConfig a -> DataType
$cdataTypeOf :: forall a. Data a => VersionConfig a -> DataType
toConstr :: VersionConfig a -> Constr
$ctoConstr :: forall a. Data a => VersionConfig a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VersionConfig a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (VersionConfig a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionConfig a -> c (VersionConfig a)
$cp1Data :: forall a. Data a => Typeable (VersionConfig a)
Data, Typeable, (forall x. VersionConfig a -> Rep (VersionConfig a) x)
-> (forall x. Rep (VersionConfig a) x -> VersionConfig a)
-> Generic (VersionConfig a)
forall x. Rep (VersionConfig a) x -> VersionConfig a
forall x. VersionConfig a -> Rep (VersionConfig a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (VersionConfig a) x -> VersionConfig a
forall a x. VersionConfig a -> Rep (VersionConfig a) x
$cto :: forall a x. Rep (VersionConfig a) x -> VersionConfig a
$cfrom :: forall a x. VersionConfig a -> Rep (VersionConfig a) x
Generic)

hashedVersionConfig :: String -> VersionConfig a
hashedVersionConfig :: String -> VersionConfig a
hashedVersionConfig String
hash = VersionConfig :: forall a.
Maybe String
-> Maybe String
-> Set String
-> Map String String
-> VersionConfig a
VersionConfig
    { vcExpectedHash :: Maybe String
vcExpectedHash = String -> Maybe String
forall a. a -> Maybe a
Just String
hash
    , vcManualName :: Maybe String
vcManualName = Maybe String
forall a. Maybe a
Nothing
    , vcIgnore :: Set String
vcIgnore = Set String
forall a. Set a
S.empty
    , vcRenames :: Map String String
vcRenames = Map String String
forall k a. Map k a
M.empty
    }

namedVersionConfig :: String -> String -> VersionConfig a
namedVersionConfig :: String -> String -> VersionConfig a
namedVersionConfig String
name String
hash = VersionConfig :: forall a.
Maybe String
-> Maybe String
-> Set String
-> Map String String
-> VersionConfig a
VersionConfig
    { vcExpectedHash :: Maybe String
vcExpectedHash = String -> Maybe String
forall a. a -> Maybe a
Just String
hash
    , vcManualName :: Maybe String
vcManualName = String -> Maybe String
forall a. a -> Maybe a
Just String
name
    , vcIgnore :: Set String
vcIgnore = Set String
forall a. Set a
S.empty
    , vcRenames :: Map String String
vcRenames = Map String String
forall k a. Map k a
M.empty
    }

encodeWithVersionQ :: Data a => VersionConfig a -> Q Exp
encodeWithVersionQ :: VersionConfig a -> Q Exp
encodeWithVersionQ = WhichFunc -> VersionConfig a -> Q Exp
forall a. Data a => WhichFunc -> VersionConfig a -> Q Exp
impl WhichFunc
Encode

decodeWithVersionQ :: Data a => VersionConfig a -> Q Exp
decodeWithVersionQ :: VersionConfig a -> Q Exp
decodeWithVersionQ = WhichFunc -> VersionConfig a -> Q Exp
forall a. Data a => WhichFunc -> VersionConfig a -> Q Exp
impl WhichFunc
Decode

data WhichFunc = Encode | Decode

impl :: forall a. Data a => WhichFunc -> VersionConfig a -> Q Exp
impl :: WhichFunc -> VersionConfig a -> Q Exp
impl WhichFunc
wf VersionConfig a
vc = do
    let proxy :: Proxy a
proxy = Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a
        info :: ByteString
info = Text -> ByteString
encodeUtf8 (String -> Text
T.pack (Set String -> Map String String -> Proxy a -> String
forall a.
Data a =>
Set String -> Map String String -> Proxy a -> String
getStructureInfo (VersionConfig a -> Set String
forall a. VersionConfig a -> Set String
vcIgnore VersionConfig a
vc) (VersionConfig a -> Map String String
forall a. VersionConfig a -> Map String String
vcRenames VersionConfig a
vc) Proxy a
proxy))
        hash :: ByteString
hash = ByteString -> ByteString
SHA1.hash ByteString
info
        hashb64 :: String
hashb64 = ByteString -> String
BS8.unpack (ByteString -> ByteString
B64Url.encode ByteString
hash)
        version :: Q Exp
version = case VersionConfig a -> Maybe String
forall a. VersionConfig a -> Maybe String
vcManualName VersionConfig a
vc of
            Maybe String
Nothing -> [e| StoreVersion hash |]
            Just String
name -> [e| StoreVersion name |]
    case VersionConfig a -> Maybe String
forall a. VersionConfig a -> Maybe String
vcExpectedHash VersionConfig a
vc of
        Maybe String
Nothing -> () -> Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
expectedHash -> do
            let shownType :: String
shownType = Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep (VersionConfig a -> Map String String
forall a. VersionConfig a -> Map String String
vcRenames VersionConfig a
vc) Int
0 (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy) String
""
            String
path <- String -> Q String
storeVersionedPath String
expectedHash
            if String
hashb64 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expectedHash
                then String -> String -> ByteString -> Q ()
writeVersionInfo String
path String
shownType ByteString
info
                else do
                    String
newPath <- String -> Q String
storeVersionedPath String
hashb64
                    String -> String -> ByteString -> Q ()
writeVersionInfo String
newPath String
shownType ByteString
info
                    Bool
exists <- IO Bool -> Q Bool
forall a. IO a -> Q a
runIO (IO Bool -> Q Bool) -> IO Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path
                    String
extraMsg <- if Bool -> Bool
not Bool
exists
                        then String -> Q String
forall (m :: * -> *) a. Monad m => a -> m a
return String
", but no file found with previously stored structural info."
                        else String -> Q String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
", use something like the following to compare with the old structural info:\n\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     String
"diff -u " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
newPath)
                    String -> Q ()
forall a. HasCallStack => String -> a
error (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$
                        String
"For " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shownType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"Data.Store.Version expected hash " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
hashb64 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
", but " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
expectedHash String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is specified.\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"The data used to construct the hash has been written to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
newPath String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
extraMsg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
    let atype :: Q Type
atype = TypeRep -> Q Type
typeRepToType (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy)
    case WhichFunc
wf of
        WhichFunc
Encode -> [e| \x -> ( getSize markEncodedVersion + getSize $(version) + getSize x
                            , poke markEncodedVersion >> poke $(version) >> poke (x :: $(atype))) |]
        WhichFunc
Decode -> [e| do
            peekMagic "version tag" markEncodedVersion
            gotVersion <- peek
            if gotVersion /= $(version)
                then fail (displayVersionError $(version) gotVersion)
                else peek :: Peek $(atype) |]

{-
                            txtWithComments <- runIO $ T.readFile path
                            let txt = T.unlines $ dropWhile ("--" `T.isPrefixOf`) $ T.lines txtWithComments
                                storedHash = BS8.unpack (B64Url.encode (SHA1.hash (encodeUtf8 txt)))
                            if storedHash == expectedHash
                                then return (", compare with the structural info that matches the hash, found in " ++ show path)
                                else return (", but the old file found also doesn't match the hash.")
-}

writeVersionInfo :: FilePath -> String -> BS.ByteString -> Q ()
writeVersionInfo :: String -> String -> ByteString -> Q ()
writeVersionInfo String
path String
shownType ByteString
info = IO () -> Q ()
forall a. IO a -> Q a
runIO (IO () -> Q ()) -> IO () -> Q ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory String
path)
    String -> Text -> IO ()
T.writeFile String
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        [ String -> Text
T.pack (String
"-- Structural info for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shownType)
        , Text
"-- Generated by an invocation of functions in Data.Store.Version"
        ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
T.lines (ByteString -> Text
decodeUtf8 ByteString
info)

storeVersionedPath :: String -> Q FilePath
storeVersionedPath :: String -> Q String
storeVersionedPath String
filename = do
    Maybe String
mstack <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (String -> IO (Maybe String)
lookupEnv String
"STACK_EXE")
    let dirName :: String
dirName = case Maybe String
mstack of
            Just String
_ -> String
".stack-work"
            Maybe String
Nothing -> String
"dist"
    String -> Q String
pathRelativeToCabalPackage (String
dirName String -> ShowS
</> String
"store-versioned" String -> ShowS
</> String
filename)

-- Implementation details

data S = S
    { S -> Map String String
sResults :: M.Map String String
    , S -> String
sCurResult :: String
    , S -> [String]
sFieldNames :: [String]
    }

getStructureInfo :: forall a. Data a => S.Set String -> M.Map String String -> Proxy a -> String
getStructureInfo :: Set String -> Map String String -> Proxy a -> String
getStructureInfo Set String
ignore Map String String
renames = Map String String -> String
renderResults (Map String String -> String)
-> (Proxy a -> Map String String) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> Map String String
sResults (S -> Map String String)
-> (Proxy a -> S) -> Proxy a -> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State S () -> S -> S) -> S -> State S () -> S
forall a b c. (a -> b -> c) -> b -> a -> c
flip State S () -> S -> S
forall s a. State s a -> s -> s
execState (Map String String -> String -> [String] -> S
S Map String String
forall k a. Map k a
M.empty String
"" []) (State S () -> S) -> (Proxy a -> State S ()) -> Proxy a -> S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> Map String String -> Proxy a -> State S ()
forall a.
Data a =>
Set String -> Map String String -> Proxy a -> State S ()
getStructureInfo' Set String
ignore Map String String
renames
  where
    renderResults :: Map String String -> String
renderResults = [String] -> String
unlines ([String] -> String)
-> (Map String String -> [String]) -> Map String String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v) ([(String, String)] -> [String])
-> (Map String String -> [(String, String)])
-> Map String String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toAscList

getStructureInfo' :: forall a. Data a => S.Set String -> M.Map String String -> Proxy a -> State S ()
getStructureInfo' :: Set String -> Map String String -> Proxy a -> State S ()
getStructureInfo' Set String
ignore Map String String
renames Proxy a
_ = do
    S
s0 <- StateT S Identity S
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Bool -> State S () -> State S ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.notMember String
label (S -> Map String String
sResults S
s0)) (State S () -> State S ()) -> State S () -> State S ()
forall a b. (a -> b) -> a -> b
$
        if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
shownType Set String
ignore
            then String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
" ignored\n"
            else case DataType -> DataRep
dataTypeRep (a -> DataType
forall a. Data a => a -> DataType
dataTypeOf (a
forall a. HasCallStack => a
undefined :: a)) of
                AlgRep [Constr]
cs -> do
                    String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
""
                    ((Bool, Constr) -> State S ()) -> [(Bool, Constr)] -> State S ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool, Constr) -> State S ()
goConstr ([Bool] -> [Constr] -> [(Bool, Constr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [Constr]
cs)
                    String
result <- (S -> String) -> StateT S Identity String
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets S -> String
sCurResult
                    String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult (if [Constr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constr]
cs then String
result String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" else String
result)
                DataRep
IntRep -> String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
" has IntRep\n"
                DataRep
FloatRep -> String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
" has FloatRep\n"
                DataRep
CharRep -> String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
" has CharRep\n"
                DataRep
NoRep
                    | String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
shownType Set String
ignore -> String -> State S ()
forall (m :: * -> *). Monad m => String -> StateT S m ()
setResult String
" has NoRep\n"
                    | Bool
otherwise -> String -> State S ()
forall a. HasCallStack => String -> a
error (String -> State S ()) -> String -> State S ()
forall a b. (a -> b) -> a -> b
$
                        String
"\nNoRep in Data.Store.Version for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
shownType String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
".\nIn the future it will be possible to statically " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"declare a global serialization version for this type. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"\nUntil then you will need to use 'vcIgnore', and " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"understand that serialization changes for affected types " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"will not be detected.\n"
  where
    setResult :: String -> StateT S m ()
setResult String
x =
         (S -> S) -> StateT S m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\S
s -> S :: Map String String -> String -> [String] -> S
S
             { sResults :: Map String String
sResults = String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
label String
x (S -> Map String String
sResults S
s)
             , sCurResult :: String
sCurResult = String
""
             , sFieldNames :: [String]
sFieldNames = []
             })
    label :: String
label = String
"data-type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
shownType
    shownType :: String
shownType = Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
0 (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) String
""
    goConstr :: (Bool, Constr) -> State S ()
    goConstr :: (Bool, Constr) -> State S ()
goConstr (Bool
isFirst, Constr
c) = do
        (S -> S) -> State S ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\S
s -> S
s
            { sFieldNames :: [String]
sFieldNames = Constr -> [String]
constrFields Constr
c [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
ix -> String
"slot " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
ix :: Int)) [Int
0..]
            , sCurResult :: String
sCurResult = S -> String
sCurResult S
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
isFirst then String
"\n  = " else String
"  | ") String -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> String
showConstr Constr
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {\n"
            })
        StateT S Identity a -> State S ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((forall d. Data d => StateT S Identity d)
-> Constr -> StateT S Identity a
forall (m :: * -> *) a.
(Monad m, Data a) =>
(forall d. Data d => m d) -> Constr -> m a
fromConstrM forall d. Data d => StateT S Identity d
goField Constr
c :: State S a)
        (S -> S) -> State S ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\S
s -> S
s { sCurResult :: String
sCurResult = S -> String
sCurResult S
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  }\n" })
    goField :: forall b. Data b => State S b
    goField :: State S b
goField = do
        S
s <- StateT S Identity S
forall (m :: * -> *) s. Monad m => StateT s m s
get
        case S -> [String]
sFieldNames S
s of
            [] -> String -> State S b
forall a. HasCallStack => String -> a
error String
"impossible case in getStructureInfo'"
            (String
name:[String]
names) -> do
                Set String -> Map String String -> Proxy b -> State S ()
forall a.
Data a =>
Set String -> Map String String -> Proxy a -> State S ()
getStructureInfo' Set String
ignore Map String String
renames (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
                S
s' <- StateT S Identity S
forall (m :: * -> *) s. Monad m => StateT s m s
get
                S -> State S ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put S
s
                    { sResults :: Map String String
sResults = S -> Map String String
sResults S
s'
                    , sCurResult :: String
sCurResult = S -> String
sCurResult S
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
0 (Proxy b -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)) String
"\n"
                    , sFieldNames :: [String]
sFieldNames = [String]
names
                    }
                b -> State S b
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> b
forall a. HasCallStack => String -> a
error String
"unexpected evaluation")

showsQualTypeRep :: M.Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep :: Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
p TypeRep
tyrep =
  let (TyCon
tycon, [TypeRep]
tys) = TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
tyrep
  in case [TypeRep]
tys of
        [] -> Map String String -> TyCon -> ShowS
showsQualTyCon Map String String
renames TyCon
tycon
        [TypeRep
x] | TyCon
tycon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tcList -> Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
0 TypeRep
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'
          where
        [TypeRep
a,TypeRep
r] | TyCon
tycon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tcFun  -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                     Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
9 TypeRep
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     String -> ShowS
showString String
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
8 TypeRep
r
        [TypeRep]
xs | TyCon -> Bool
isTupleTyCon TyCon
tycon -> Map String String -> [TypeRep] -> ShowS
showTuple Map String String
renames [TypeRep]
xs
           | Bool
otherwise         ->
                Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                Map String String -> TyCon -> ShowS
showsQualTyCon Map String String
renames TyCon
tycon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Char -> ShowS
showChar Char
' '      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Map String String -> ShowS -> [TypeRep] -> ShowS
showArgs Map String String
renames (Char -> ShowS
showChar Char
' ') [TypeRep]
tys

showsQualTyCon :: M.Map String String -> TyCon -> ShowS
showsQualTyCon :: Map String String -> TyCon -> ShowS
showsQualTyCon Map String String
renames TyCon
tc = String -> ShowS
showString (String -> String -> Map String String -> String
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault String
name String
name Map String String
renames)
  where
    name :: String
name = TyCon -> String
tyConModule TyCon
tc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyCon -> String
tyConName TyCon
tc

isTupleTyCon :: TyCon -> Bool
isTupleTyCon :: TyCon -> Bool
isTupleTyCon TyCon
tc
  | (Char
'(':Char
',':String
_) <- TyCon -> String
tyConName TyCon
tc = Bool
True
  | Bool
otherwise                   = Bool
False

showArgs :: M.Map String String -> ShowS -> [TypeRep] -> ShowS
showArgs :: Map String String -> ShowS -> [TypeRep] -> ShowS
showArgs Map String String
_       ShowS
_   []     = ShowS
forall a. a -> a
id
showArgs Map String String
renames ShowS
_   [TypeRep
a]    = Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
10 TypeRep
a
showArgs Map String String
renames ShowS
sep (TypeRep
a:[TypeRep]
as) = Map String String -> Int -> TypeRep -> ShowS
showsQualTypeRep Map String String
renames Int
10 TypeRep
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sep ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> ShowS -> [TypeRep] -> ShowS
showArgs Map String String
renames ShowS
sep [TypeRep]
as

showTuple :: M.Map String String -> [TypeRep] -> ShowS
showTuple :: Map String String -> [TypeRep] -> ShowS
showTuple Map String String
renames [TypeRep]
args
    = Char -> ShowS
showChar Char
'('
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> ShowS -> [TypeRep] -> ShowS
showArgs Map String String
renames (Char -> ShowS
showChar Char
',') [TypeRep]
args
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'

tcList :: TyCon
tcList :: TyCon
tcList = Proxy [()] -> TyCon
forall a. Typeable a => Proxy a -> TyCon
tyConOf (Proxy [()]
forall k (t :: k). Proxy t
Proxy :: Proxy [()])

tcFun :: TyCon
tcFun :: TyCon
tcFun = Proxy (Int -> Int) -> TyCon
forall a. Typeable a => Proxy a -> TyCon
tyConOf (Proxy (Int -> Int)
forall k (t :: k). Proxy t
Proxy :: Proxy (Int -> Int))

tyConOf :: Typeable a => Proxy a -> TyCon
tyConOf :: Proxy a -> TyCon
tyConOf = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (Proxy a -> TypeRep) -> Proxy a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep

displayVersionError :: StoreVersion -> StoreVersion -> String
displayVersionError :: StoreVersion -> StoreVersion -> String
displayVersionError StoreVersion
expectedVersion StoreVersion
receivedVersion =
    String
"Mismatch detected by Data.Store.Version - expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Text -> String
T.unpack (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (StoreVersion -> ByteString
unStoreVersion StoreVersion
expectedVersion)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Text -> String
T.unpack (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (StoreVersion -> ByteString
unStoreVersion StoreVersion
receivedVersion))

markEncodedVersion :: Word32
markEncodedVersion :: Word32
markEncodedVersion = Word32
3908297288