can-i-haz (empty) → 0.1.0.0

raw patch · 9 files changed

+225/−0 lines, 9 filesdep +basedep +can-i-hazdep +deepseqsetup-changed

Dependencies added: base, can-i-haz, deepseq, hspec, should-not-typecheck

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
can-i-haz.cabal +58/−0
src/Control/Monad/Reader/Has.hs +58/−0
test/Common.hs +23/−0
test/Spec.hs +30/−0
test/TypecheckFailures.hs +16/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Changelog for can-i-haz++## 0.1.0.0++Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Georg Rudoy (c) 2019++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 Georg Rudoy 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.

+ README.md view

@@ -0,0 +1,3 @@+# can-i-haz++`Generic` implementation of the Has-pattern (mostly useful with `MonadReader`).

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ can-i-haz.cabal view

@@ -0,0 +1,58 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 859b8021274842401b027ff7b3ee5ec1352f7970b8feb144c40deffa5a44b026++name:           can-i-haz+version:        0.1.0.0+synopsis:       Generic implementation of the Has pattern+description:    Please see the README on GitHub at <https://github.com/0xd34df00d/can-i-haz#readme>+category:       Control+homepage:       https://github.com/0xd34df00d/can-i-haz#readme+bug-reports:    https://github.com/0xd34df00d/can-i-haz/issues+author:         Georg Rudoy+maintainer:     0xd34df00d@gmail.com+copyright:      2019 Georg Rudoy+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/0xd34df00d/can-i-haz++library+  exposed-modules:+      Control.Monad.Reader.Has+  other-modules:+      Paths_can_i_haz+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+  default-language: Haskell2010++test-suite can-i-haz-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Common+      TypecheckFailures+      Paths_can_i_haz+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , can-i-haz+    , deepseq+    , hspec+    , should-not-typecheck+  default-language: Haskell2010

+ src/Control/Monad/Reader/Has.hs view

@@ -0,0 +1,58 @@+{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, ConstraintKinds #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables, DefaultSignatures #-}++module Control.Monad.Reader.Has+( Has(..)+) where++import Data.Proxy+import GHC.Generics++data Path = L Path | R Path | Here deriving (Show)+data MaybePath = NotFound | Conflict | Found Path deriving (Show)++type family Combine p1 p2 where+  Combine ('Found path) 'NotFound = 'Found ('L path)+  Combine 'NotFound ('Found path) = 'Found ('R path)+  Combine 'NotFound 'NotFound = 'NotFound+  Combine _ _ = 'Conflict++type family Search part (g :: k -> *) :: MaybePath where+  Search part (K1 _ part) = 'Found 'Here+  Search part (K1 _ other) = 'NotFound+  Search part (M1 _ _ x) = Search part x+  Search part (f :*: g) = Combine (Search part f) (Search part g)+  Search _ _ = 'NotFound++class GHas (path :: Path) part grecord where+  gextract :: Proxy path -> grecord p -> part++instance GHas 'Here rec (K1 i rec) where+  gextract _ (K1 x) = x++instance GHas path part struct => GHas path part (M1 i t struct) where+  gextract proxy (M1 x) = gextract proxy x++instance GHas path part l => GHas ('L path) part (l :*: r) where+  gextract _ (l :*: _) = gextract (Proxy :: Proxy path) l++instance GHas path part r => GHas ('R path) part (l :*: r) where+  gextract _ (_ :*: r) = gextract (Proxy :: Proxy path) r++type SuccessfulSearch part record path = (Search part (Rep record) ~ 'Found path, GHas path part (Rep record))++class Has part record where+  extract :: record -> part+  default extract :: forall path. (Generic record, SuccessfulSearch part record path) => record -> part+  extract = gextract (Proxy :: Proxy path) . from++instance Has record record where+  extract = id++instance SuccessfulSearch a0 (a0, a1) path => Has a0 (a0, a1)+instance SuccessfulSearch a1 (a0, a1) path => Has a1 (a0, a1)++instance SuccessfulSearch a0 (a0, a1, a2) path => Has a0 (a0, a1, a2)+instance SuccessfulSearch a1 (a0, a1, a2) path => Has a1 (a0, a1, a2)+instance SuccessfulSearch a2 (a0, a1, a2) path => Has a2 (a0, a1, a2)

+ test/Common.hs view

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}++module Common where++import Control.DeepSeq+import GHC.Generics++import Control.Monad.Reader.Has++data FooEnv = FooEnv+  { fooInt :: Int+  , fooStr :: String+  } deriving (Eq, Ord, Show, Generic, NFData)++data BarEnv = BarEnv+  { barDouble :: Double+  , barArr :: [Int]+  } deriving (Eq, Ord, Show, Generic, NFData)++data AppEnv = AppEnv+  { fooEnv :: FooEnv+  , barEnv :: BarEnv+  } deriving (Eq, Ord, Show, Generic, NFData, Has FooEnv, Has BarEnv)

+ test/Spec.hs view

@@ -0,0 +1,30 @@+import Test.Hspec+import Test.ShouldNotTypecheck++import Control.Monad.Reader.Has++import Common+import TypecheckFailures++main :: IO ()+main = hspec $ do+  let baseFooEnv = FooEnv 10 "meh"+  let baseBarEnv = BarEnv 4.2 [1, 2, 3]+  describe "Basic Has instance" $+    it "any type Has itself" $ do+      let exFoo = extract baseFooEnv+      exFoo `shouldBe` baseFooEnv+  describe "Generic Has instances" $ do+    it "envs have their components" $ do+      let exFoo = extract $ AppEnv baseFooEnv baseBarEnv+      exFoo `shouldBe` baseFooEnv+      let exBar = extract $ AppEnv baseFooEnv baseBarEnv+      exBar `shouldBe` baseBarEnv+    it "tuples have their components" $ do+      let exFoo = extract (baseFooEnv, baseBarEnv)+      exFoo `shouldBe` baseFooEnv+      let exBar = extract (baseFooEnv, baseBarEnv)+      exBar `shouldBe` baseBarEnv+  describe "Should not typecheck" $ do+    it "if there is no such type in the hierarchy" $ shouldNotTypecheck extractMissing+    it "if there is more than one such type in the hierarchy" $ shouldNotTypecheck extractMultiple

+ test/TypecheckFailures.hs view

@@ -0,0 +1,16 @@+{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors -Wno-orphans #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module TypecheckFailures where++import Control.Monad.Reader.Has++import Common++instance Has FooEnv BarEnv++extractMissing :: FooEnv -> BarEnv+extractMissing = extract++extractMultiple :: (FooEnv, FooEnv) -> FooEnv+extractMultiple = extract