mirror of
https://github.com/i-am-tom/higgledy.git
synced 2024-09-11 16:16:43 +03:00
Documentation [Build/Default]
Going to add these as I complete them. Useful documentation and some small examples.
This commit is contained in:
parent
aa8c83e404
commit
77aec38fbb
@ -4,23 +4,36 @@
|
||||
{-# LANGUAGE MonoLocalBinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Data.Partial.Build where
|
||||
module Data.Partial.Build
|
||||
( impartial
|
||||
, HasPartial (..)
|
||||
) where
|
||||
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.Lens (Prism', prism')
|
||||
import Data.Kind (Type)
|
||||
import Data.Partial.Types (Partial (..), GPartial_)
|
||||
import GHC.Generics
|
||||
|
||||
-- | We can construct partial equivalents of complete structures, and attempt
|
||||
-- to build complete structures from partial representations.
|
||||
impartial
|
||||
:: ( Generic structure
|
||||
, HasPartial structure
|
||||
)
|
||||
=> Prism' (Partial structure) structure
|
||||
|
||||
-- | We can construct a prism from a partial structure to its complete
|
||||
-- structure, which will "succeed" if all values in the structure have been
|
||||
-- populated.
|
||||
--
|
||||
-- >>> :set -XTypeApplications
|
||||
-- >>> import Control.Lens
|
||||
--
|
||||
-- >>> mempty ^? impartial @(Int, String)
|
||||
-- Nothing
|
||||
--
|
||||
-- >>> toPartial ("Hello", True) ^? impartial
|
||||
-- Just ("Hello",True)
|
||||
impartial :: (Generic a, HasPartial a) => Prism' (Partial a) a
|
||||
impartial = prism' toPartial fromPartial
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- | As this is implemented with generics, an instance is implied for any type
|
||||
-- that implements 'Generic' sensibly.
|
||||
class HasPartial (structure :: Type) where
|
||||
toPartial :: structure -> Partial structure
|
||||
fromPartial :: Partial structure -> Maybe structure
|
||||
@ -35,8 +48,8 @@ instance GHasPartial inner => GHasPartial (M1 index meta inner) where
|
||||
|
||||
instance (GHasPartial left, GHasPartial right)
|
||||
=> GHasPartial (left :*: right) where
|
||||
gtoPartial (left :*: right) = (:*:) (gtoPartial left) (gtoPartial right)
|
||||
gfromPartial (left :*: right) = (:*:) <$> gfromPartial left <*> gfromPartial right
|
||||
gtoPartial (l :*: r) = (:*:) ( gtoPartial l) ( gtoPartial r)
|
||||
gfromPartial (l :*: r) = liftA2 (:*:) (gfromPartial l) (gfromPartial r)
|
||||
|
||||
instance GHasPartial (K1 index inner) where
|
||||
gtoPartial = K1 . Just . unK1
|
||||
|
@ -3,24 +3,45 @@
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Data.Partial.Default where
|
||||
module Data.Partial.Default
|
||||
( Defaults (..)
|
||||
) where
|
||||
|
||||
import Data.Kind (Type)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Partial.Types (Partial (..), GPartial_)
|
||||
import GHC.Generics
|
||||
|
||||
-- | We can build structures from partial representations without a 'Maybe' if
|
||||
-- we can provide a structure full of defaults. When a field is missing, we
|
||||
-- just use the field in the default structure.
|
||||
-- | We can be guaranteed to reconstruct a value from a partial structure if we
|
||||
-- also supply a structure of defaults. Every time we encounter a missing
|
||||
-- field, we borrow a value from the defaults!
|
||||
--
|
||||
-- >>> :set -XDataKinds
|
||||
-- >>> import Control.Lens
|
||||
-- >>> import Data.Partial.Position
|
||||
--
|
||||
-- If we have an empty partial object, it will be entirely populated by the
|
||||
-- defaults:
|
||||
--
|
||||
-- >>> defaults ("Tom", True) mempty
|
||||
-- ("Tom",True)
|
||||
--
|
||||
-- As we add data to our partial structure, these are prioritised over the
|
||||
-- defaults:
|
||||
--
|
||||
-- >>> defaults ("Tom", True) (mempty & position @1 ?~ "Haskell")
|
||||
-- ("Haskell",True)
|
||||
class Defaults (structure :: Type) where
|
||||
defaults :: structure -> Partial structure -> structure
|
||||
|
||||
class GDefaults (rep :: Type -> Type) where
|
||||
gdefaults :: rep p -> GPartial_ rep q -> rep r
|
||||
|
||||
instance GDefaults inner => GDefaults (M1 index meta inner) where
|
||||
gdefaults (M1 x) (M1 y) = M1 (gdefaults x y)
|
||||
instance GDefaults inner
|
||||
=> GDefaults (M1 index meta inner) where
|
||||
|
||||
gdefaults (M1 x) (M1 y)
|
||||
= M1 (gdefaults x y)
|
||||
|
||||
instance (GDefaults left, GDefaults right)
|
||||
=> GDefaults (left :*: right) where
|
||||
@ -28,8 +49,10 @@ instance (GDefaults left, GDefaults right)
|
||||
= gdefaults leftX leftY :*: gdefaults rightX rightY
|
||||
|
||||
instance GDefaults (K1 index inner) where
|
||||
gdefaults (K1 inner) (K1 partial) = K1 (fromMaybe inner partial)
|
||||
gdefaults (K1 inner) (K1 partial)
|
||||
= K1 (fromMaybe inner partial)
|
||||
|
||||
instance (Generic structure, GDefaults (Rep structure))
|
||||
=> Defaults structure where
|
||||
defaults x (Partial y) = to (gdefaults (from x) y)
|
||||
defaults x (Partial y)
|
||||
= to (gdefaults (from x) y)
|
||||
|
Loading…
Reference in New Issue
Block a user