coco-0.0.1.0: Coco.hs

{-|
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.Applicative (empty)
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 Data.Aeson as Aeson
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 in (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

instance To Aeson.Value TS.Text where to = Aeson.String
instance MaybeTo Aeson.Value TS.Text
instance MaybeTo TS.Text Aeson.Value where
	maybeTo (Aeson.String s) = pure s
	maybeTo _ = empty
instance To Aeson.Value T.Text where to = to . to @TS.Text
instance MaybeTo Aeson.Value T.Text
instance MaybeTo T.Text Aeson.Value where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo Aeson.Value String where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo String Aeson.Value where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo Aeson.Value B.ByteString where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo B.ByteString Aeson.Value where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo Aeson.Value BS.ByteString where maybeTo = fmap to . maybeTo @TS.Text
instance MaybeTo BS.ByteString Aeson.Value where maybeTo = fmap to . maybeTo @TS.Text
instance To Aeson.Value UUID where to = to . to @TS.Text
instance MaybeTo Aeson.Value UUID
instance MaybeTo UUID Aeson.Value where maybeTo = maybeTo @TS.Text >=> maybeTo