diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# Version 0.1 + +* Initial release. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (c) 2015, Renzo Carbonara + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Renzo Carbonara nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +See the README file in the @exinst@ package for more general documentation: +https://hackage.haskell.org/package/exinst#readme diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/exinst-bytes.cabal b/exinst-bytes.cabal new file mode 100644 --- /dev/null +++ b/exinst-bytes.cabal @@ -0,0 +1,28 @@ +name: exinst-bytes +version: 0.1 +author: Renzo Carbonara +maintainer: renzoλcarbonara.com.ar +copyright: Renzo Carbonara 2015 +license: BSD3 +license-file: LICENSE.txt +extra-source-files: README.md CHANGELOG.md +category: Data +build-type: Simple +cabal-version: >=1.18 +synopsis: Derive instances for the `bytes` library for your existential types. +homepage: https://github.com/k0001/exinst +bug-reports: https://github.com/k0001/exinst/issues + +library + hs-source-dirs: src/lib + default-language: Haskell2010 + exposed-modules: + Exinst.Instances.Bytes + build-depends: + base >=4.7 && <4.9 + , bytes >=0.15 && <0.16 + , constraints >=0.4 && <0.5 + , exinst >=0.1 && <0.2 + , singletons >=1.1 && <1.2 + ghcjs-options: -Wall -O3 + ghc-options: -Wall -O2 diff --git a/src/lib/Exinst/Instances/Bytes.hs b/src/lib/Exinst/Instances/Bytes.hs new file mode 100644 --- /dev/null +++ b/src/lib/Exinst/Instances/Bytes.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | This module exports 'By.Serial' instances for 'Some1', 'Some2', 'Some3' +-- and 'Some4' from "Exinst.Singletons", provided situable 'Dict1', 'Dict2', +-- 'Dict3' and 'Dict4' instances are available. +-- +-- See the README file in the @exinst@ package for more general documentation: +-- https://hackage.haskell.org/package/exinst#readme +module Exinst.Instances.Bytes () where + +import qualified Data.Bytes.Serial as By +import Data.Constraint +import Data.Singletons +import Exinst.Singletons +import Prelude + +-------------------------------------------------------------------------------- + +instance forall (f1 :: k1 -> *) + . ( SingKind ('KProxy :: KProxy k1) + , By.Serial (DemoteRep ('KProxy :: KProxy k1)) + , Dict1 By.Serial f1 + ) => By.Serial (Some1 f1) + where + {-# INLINABLE serialize #-} + serialize = \some1x -> withSome1Sing some1x $ \sa1 (x :: f1 a1) -> + case dict1 sa1 :: Dict (By.Serial (f1 a1)) of + Dict -> do By.serialize (fromSing sa1) + By.serialize x + {-# INLINABLE deserialize #-} + deserialize = do + rsa1 <- By.deserialize + withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $ + case dict1 sa1 :: Dict (By.Serial (f1 a1)) of + Dict -> do x :: f1 a1 <- By.deserialize + return (some1 x) + +instance forall (f2 :: k2 -> k1 -> *) + . ( SingKind ('KProxy :: KProxy k2) + , SingKind ('KProxy :: KProxy k1) + , By.Serial (DemoteRep ('KProxy :: KProxy k2)) + , By.Serial (DemoteRep ('KProxy :: KProxy k1)) + , Dict2 By.Serial f2 + ) => By.Serial (Some2 f2) + where + {-# INLINABLE serialize #-} + serialize = \some2x -> withSome2Sing some2x $ \sa2 sa1 (x :: f2 a2 a1) -> + case dict2 sa2 sa1 :: Dict (By.Serial (f2 a2 a1)) of + Dict -> do By.serialize (fromSing sa2, fromSing sa1) + By.serialize x + {-# INLINABLE deserialize #-} + deserialize = do + (rsa2, rsa1) <- By.deserialize + withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $ + withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $ + case dict2 sa2 sa1 :: Dict (By.Serial (f2 a2 a1)) of + Dict -> do x :: f2 a2 a1 <- By.deserialize + return (some2 x) + +instance forall (f3 :: k3 -> k2 -> k1 -> *) + . ( SingKind ('KProxy :: KProxy k3) + , SingKind ('KProxy :: KProxy k2) + , SingKind ('KProxy :: KProxy k1) + , By.Serial (DemoteRep ('KProxy :: KProxy k3)) + , By.Serial (DemoteRep ('KProxy :: KProxy k2)) + , By.Serial (DemoteRep ('KProxy :: KProxy k1)) + , Dict3 By.Serial f3 + ) => By.Serial (Some3 f3) + where + {-# INLINABLE serialize #-} + serialize = \some3x -> withSome3Sing some3x $ \sa3 sa2 sa1 (x :: f3 a3 a2 a1) -> + case dict3 sa3 sa2 sa1 :: Dict (By.Serial (f3 a3 a2 a1)) of + Dict -> do By.serialize (fromSing sa3, fromSing sa2, fromSing sa1) + By.serialize x + {-# INLINABLE deserialize #-} + deserialize = do + (rsa3, rsa2, rsa1) <- By.deserialize + withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) -> withSingI sa3 $ + withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $ + withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $ + case dict3 sa3 sa2 sa1 :: Dict (By.Serial (f3 a3 a2 a1)) of + Dict -> do x :: f3 a3 a2 a1 <- By.deserialize + return (some3 x) + +instance forall (f4 :: k4 -> k3 -> k2 -> k1 -> *) + . ( SingKind ('KProxy :: KProxy k4) + , SingKind ('KProxy :: KProxy k3) + , SingKind ('KProxy :: KProxy k2) + , SingKind ('KProxy :: KProxy k1) + , By.Serial (DemoteRep ('KProxy :: KProxy k4)) + , By.Serial (DemoteRep ('KProxy :: KProxy k3)) + , By.Serial (DemoteRep ('KProxy :: KProxy k2)) + , By.Serial (DemoteRep ('KProxy :: KProxy k1)) + , Dict4 By.Serial f4 + ) => By.Serial (Some4 f4) + where + {-# INLINABLE serialize #-} + serialize = \some4x -> withSome4Sing some4x $ \sa4 sa3 sa2 sa1 (x :: f4 a4 a3 a2 a1) -> + case dict4 sa4 sa3 sa2 sa1 :: Dict (By.Serial (f4 a4 a3 a2 a1)) of + Dict -> do By.serialize (fromSing sa4, fromSing sa3, + fromSing sa2, fromSing sa1) + By.serialize x + {-# INLINABLE deserialize #-} + deserialize = do + (rsa4, rsa3, rsa2, rsa1) <- By.deserialize + withSomeSing rsa4 $ \(sa4 :: Sing (a4 :: k4)) -> withSingI sa4 $ + withSomeSing rsa3 $ \(sa3 :: Sing (a3 :: k3)) -> withSingI sa3 $ + withSomeSing rsa2 $ \(sa2 :: Sing (a2 :: k2)) -> withSingI sa2 $ + withSomeSing rsa1 $ \(sa1 :: Sing (a1 :: k1)) -> withSingI sa1 $ + case dict4 sa4 sa3 sa2 sa1 :: Dict (By.Serial (f4 a4 a3 a2 a1)) of + Dict -> do x :: f4 a4 a3 a2 a1 <- By.deserialize + return (some4 x)