+++ /dev/null
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-
--- These can go if the tuple instances are accepted upstream.
-
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Generics (
- Generic(..),
- prepend,
- to_tuple )
-where
-
-import Generics.SOP ( Code, Generic(..), I(..), NP(..), NS(..), SOP(..) )
-import Generics.SOP.TH ( deriveGeneric )
-
--- Derive instances for tuples of size <= 30. The predefined instances
--- in generics-sop only go up to 15 components.
-deriveGeneric ''(,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,) -- 20
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,) -- 25
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
-deriveGeneric ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) -- 30
-
-
--- | Convert a simple product type into a tuple, generically.
---
--- ==== __Examples__:
---
--- >>> import qualified GHC.Generics as GHC ( Generic )
--- >>> data Foo = Bar Int Int Int Int deriving (Show, GHC.Generic)
--- >>> instance Generic Foo
--- >>> let b = Bar 1 2 3 4
--- >>> to_tuple b :: (Int,Int,Int,Int)
--- (1,2,3,4)
---
-to_tuple:: (Generic a, Generic c, Code a ~ Code c) => a -> c
-to_tuple = to . from
-
--- | This type function takes a type-level list-of-lists, @xss@, and
--- prepends the type @a@ to each tpye-level list in @xss@.
---
--- The dubious '[] clause makes sense when you realize that we're
--- appending to the inner lists, none of which exist if @xss@ is
--- empty.
---
-type family Prepended a (xss :: [k]) :: [l]
-type instance Prepended a '[] = '[]
-type instance Prepended a (x ': xs) = (a ': x) ': (Prepended a xs)
-
-
--- | Prepend a value of type @a@ to a product type that is represented
--- as a sum-of-products. The @SOP I@ part of the signature basically
--- means that it's a plain Haskell type, represented as a sum of
--- products. The @xss@ argument is a type-level list-of-lists
--- representing the \"shape\" of the type.
---
--- We're going to prepend a value of type @a@ to our argument, no
--- matter its constructor. So the shape of the return value will
--- differ from the shape of the argument. How? Each constructor (one
--- list in the list-of-lists) will have a new value of type @a@
--- appended to it. We represent this by appending the type @a@
--- itself to the type-level lists contained in @xss@. All of this is
--- handled by the type family 'Prepended'.
---
--- ==== __Examples__
---
--- >>> import qualified GHC.Generics as GHC
--- >>> data Foo = Foo Int Int | Bar Int Int Int deriving (Show, GHC.Generic)
--- >>> instance Generic Foo
--- >>> prepend_sop "Hello" (from $ Foo 1 2)
--- SOP (Z (I "Hello" :* (I 1 :* (I 2 :* Nil))))
--- >>> prepend_sop "Hello" (from $ Bar 1 2 3)
--- SOP (S (Z (I "Hello" :* (I 1 :* (I 2 :* (I 3 :* Nil))))))
---
-prepend_sop :: a -> SOP I xss -> SOP I (Prepended a xss)
-prepend_sop z (SOP (Z rest)) = SOP $ Z ((I z) :* rest)
-prepend_sop z (SOP (S rest)) =
- let (SOP result) = prepend_sop z (SOP rest)
- in SOP $ S $ result
-
--- | Prepend a field to a simple type, generically. This uses the
--- magic from "Generics.SOP" to,
---
--- 1. Convert the argumnt to a sum-of-profucts
--- 2. Use 'prepend_sop' to prepend the new value to the
--- sum-of-products representation.
--- 3. Convert the result back to /any/ isomorphic type, not
--- necessarily the original type!
---
--- You do need to indicate the type of the return value usually if it
--- can't be inferred.
---
--- ==== __Examples__
---
--- The \"BigF\" type below matches up with \"F\", except each
--- constructor for \"BigF\" has a 'String' field in front of
--- it. We can convert from \"F\" to \"BigF\" by prepending a
--- String:
---
--- >>> import qualified GHC.Generics as GHC
--- >>> data F = F Int | B Int Int deriving (Show, GHC.Generic)
--- >>> instance Generic F
--- >>> data BigF = BigF String Int | BigB String Int Int deriving (Show, GHC.Generic)
--- >>> instance Generic BigF
--- >>> prepend "Hello" (F 1) :: Big
--- BigF "Hello" 1
--- >>> prepend "Hello" (B 1 2) :: BigF
--- BigB "Hello" 1 2
---
-prepend :: (Generic a, Generic c, Prepended b (Code a) ~ Code c) => b -> a -> c
-prepend z = to . (prepend_sop z) . from