coco (empty) → 0.0.0.0
raw patch · 3 files changed
+214/−0 lines, 3 filesdep +basedep +bytestringdep +template-haskell
Dependencies added: base, bytestring, template-haskell, text, utf8-string, utility-ht, uuid
Files
- Coco.hs +120/−0
- Coco/TH.hs +62/−0
- coco.cabal +32/−0
+ Coco.hs view
@@ -0,0 +1,120 @@+{-|+Other conversion packages define isomorphisms and such, but that doesn't guarantee you converting a to b and b to c is the same as converting a to c.+This package is designed to guarantee conversions are compatible to each other.+Feel free to request instances.+-}+module Coco where+import qualified Language.Haskell.TH as TH+import Data.Void (Void)+import Control.Monad (guard)+import Data.Either.HT (maybeRight)+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.UTF8 as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BS+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as T+import qualified Data.Text as TS+import qualified Data.Text.Encoding as TS+import Data.UUID (UUID)+import qualified Data.UUID as UUID+import qualified Coco.TH++{-|+Rules:++* Both types must be monomorphic.++* If two of @MaybeTo b a@, @MaybeTo c b@ and @MaybeTo c a@ are defined in your module, the third must be available (not necessarily defined) in your module.++* For any @a@, @maybeTo a >>= maybeTo@ must be either @maybeTo a@ or @Nothing@.+-}+class MaybeTo b a where+ maybeTo :: a -> Maybe b+ default maybeTo :: To b a => a -> Maybe b+ maybeTo = pure . to++-- | > maybeTo = pure . to+class MaybeTo b a => To b a where+ to :: a -> b+ default to :: a ~ b => a -> b+ to = id++-- | swapped type arguments for convenience+from :: forall a b. To b a => a -> b+from = to++-- | swapped type arguments for convenience+maybeFrom :: forall a b. MaybeTo b a => a -> Maybe b+maybeFrom = maybeTo++-- | turn a lossy conversion function into a viable 'maybeTo'+maybeToViaLossy :: (Eq a, To a b) => (a -> b) -> a -> Maybe b+maybeToViaLossy f a = f a <$ guard (a == to (f a))++-- | reduce boilerplate when defining @To a a@ instances+instanceId :: Applicative q => [TH.Name] -> q [TH.Dec]+instanceId = Coco.TH.instance2 ''MaybeTo ''To++-- | reduce boilerplate when defining @MaybeTo Void a@ instances+instanceMaybeToVoid :: Applicative q => [TH.Name] -> q [TH.Dec]+instanceMaybeToVoid = Coco.TH.instanceMaybeToVoid ''MaybeTo 'maybeTo++-- | reduce boilerplate when defining @To a Void@ instances+instanceFromVoid :: Applicative q => [TH.Name] -> q [TH.Dec]+instanceFromVoid = Coco.TH.instanceFromVoid ''MaybeTo ''To 'to++$(Coco.TH.instance2 ''To ''MaybeTo (''Void : Coco.TH.nonVoid))+$(Coco.TH.instanceMaybeToVoid ''MaybeTo 'maybeTo Coco.TH.nonVoid)+$(Coco.TH.instanceFromVoid ''MaybeTo ''To 'to Coco.TH.nonVoid)++instance To B.ByteString BS.ByteString where to = B.fromStrict+instance MaybeTo B.ByteString BS.ByteString+instance To BS.ByteString B.ByteString where to = B.toStrict+instance MaybeTo BS.ByteString B.ByteString++instance To T.Text TS.Text where to = T.fromStrict+instance MaybeTo T.Text TS.Text+instance To TS.Text T.Text where to = T.toStrict+instance MaybeTo TS.Text T.Text++instance To String T.Text where to = T.unpack+instance MaybeTo String T.Text+instance MaybeTo T.Text String where maybeTo = maybeToViaLossy T.pack+instance To String TS.Text where to = TS.unpack+instance MaybeTo String TS.Text+instance MaybeTo TS.Text String where maybeTo = maybeToViaLossy TS.pack++instance To B.ByteString T.Text where to = T.encodeUtf8+instance MaybeTo B.ByteString T.Text+instance MaybeTo T.Text B.ByteString where maybeTo = maybeRight . T.decodeUtf8'+instance To BS.ByteString T.Text where to = to . to @B.ByteString+instance MaybeTo BS.ByteString T.Text+instance MaybeTo T.Text BS.ByteString where maybeTo = maybeTo . to @B.ByteString+instance To B.ByteString TS.Text where to = to . to @T.Text+instance MaybeTo B.ByteString TS.Text+instance MaybeTo TS.Text B.ByteString where maybeTo = fmap to . maybeTo @T.Text+instance To BS.ByteString TS.Text where to = TS.encodeUtf8+instance MaybeTo BS.ByteString TS.Text+instance MaybeTo TS.Text BS.ByteString where maybeTo = maybeRight . TS.decodeUtf8'+instance To B.ByteString String where to = B.fromString+instance MaybeTo B.ByteString String+instance MaybeTo String B.ByteString where maybeTo = maybeToViaLossy B.toString+instance To BS.ByteString String where to = BS.fromString+instance MaybeTo BS.ByteString String+instance MaybeTo String BS.ByteString where maybeTo = maybeToViaLossy BS.toString++instance To String UUID where to = UUID.toString+instance MaybeTo String UUID+instance MaybeTo UUID String where maybeTo = UUID.fromString+instance To T.Text UUID where to = to . to @TS.Text+instance MaybeTo T.Text UUID+instance To TS.Text UUID where to = UUID.toText+instance MaybeTo TS.Text UUID+instance MaybeTo UUID TS.Text where maybeTo = UUID.fromText+instance To B.ByteString UUID where to = UUID.toLazyASCIIBytes+instance MaybeTo B.ByteString UUID+instance MaybeTo UUID B.ByteString where maybeTo = UUID.fromLazyASCIIBytes+instance To BS.ByteString UUID where to = UUID.toASCIIBytes+instance MaybeTo BS.ByteString UUID+instance MaybeTo UUID BS.ByteString where maybeTo = UUID.fromASCIIBytes
+ Coco/TH.hs view
@@ -0,0 +1,62 @@+module Coco.TH where+import qualified Language.Haskell.TH as TH+import Data.Void (Void, absurd)+import Control.Applicative (empty)+import Control.Monad (join)+import Data.Foldable1 (Foldable1, foldl1')+import Data.List.NonEmpty (NonEmpty((:|)))+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString as BS+import qualified Data.Text.Lazy as T+import qualified Data.Text as TS+import Data.UUID (UUID)++instanceD :: (Functor t, Foldable1 t) => [TH.Dec] -> t TH.Name -> TH.Dec+instanceD = flip+ $ TH.InstanceD empty empty+ . foldl1' TH.AppT+ . fmap TH.ConT++funD :: TH.Name -> TH.Exp -> [TH.Dec]+funD name+ = pure+ . TH.FunD name+ . pure+ . flip (TH.Clause empty) empty+ . TH.NormalB++instance2 :: Applicative q => TH.Name -> TH.Name -> [TH.Name] -> q [TH.Dec]+instance2 a b+ = pure+ . fmap (instanceD empty)+ . (fmap (:|) [a, b] <*>)+ . fmap (join (<>) . pure)++instanceMaybeToVoid :: Applicative q => TH.Name -> TH.Name -> [TH.Name] -> q [TH.Dec]+instanceMaybeToVoid cls fn = pure . fmap+ ( instanceD+ ( funD fn+ $ TH.AppE (TH.VarE 'pure)+ $ TH.VarE 'empty+ )+ . (cls :|)+ . (''Void :)+ . pure+ )++instanceFromVoid :: Applicative q => TH.Name -> TH.Name -> TH.Name -> [TH.Name] -> q [TH.Dec]+instanceFromVoid clsMaybeTo clsTo fnTo+ = pure+ . (<*>)+ [ instanceD+ ( funD fnTo+ $ TH.VarE 'absurd+ )+ . (clsTo :|)+ , instanceD empty+ . (clsMaybeTo :|)+ ]+ . fmap (: [''Void])++nonVoid :: [TH.Name]+nonVoid = [''B.ByteString, ''BS.ByteString, ''T.Text, ''TS.Text, ''String, ''UUID]
+ coco.cabal view
@@ -0,0 +1,32 @@+cabal-version: 3.8+name: coco+version: 0.0.0.0+build-type: Simple+category: Conversion+author: Konrad Czech+maintainer: konrad@disroot.org+synopsis: compatible conversions+description:+ Other conversion packages define isomorphisms and such, but that doesn't guarantee you converting a to b and b to c is the same as converting a to c.+ This package is designed to guarantee conversions are compatible to each other.+license: MIT+homepage: https://codeberg.org/czech/coco+bug-reports: https://codeberg.org/czech/coco/issues+source-repository head+ type: git+ location: https://codeberg.org/czech/coco.git++library+ ghc-options: -Wall -Wno-tabs+ default-language: GHC2021+ default-extensions: OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeFamilyDependencies, DerivingStrategies, UndecidableInstances, DataKinds, CPP, LambdaCase, DefaultSignatures+ build-depends:+ base >= 4.18 && < 4.23,+ template-haskell >= 2.20 && < 2.25,+ utility-ht >= 0.0.16 && < 0.1,+ bytestring >= 0.11.3 && < 0.13,+ utf8-string >= 1.0.1.1 && < 1.1,+ text >= 1.2.5.0 && < 2.2,+ uuid >= 1.3.15 && < 1.4+ exposed-modules: Coco+ other-modules: Coco.TH