816df4d · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Update for new dependent-sum/map + universe

816df4dAli Abrar7 years ago

default.nix+11−8

compare with master

unifiedsplit

@@ -32,6 +32,7 @@ let

32 # Fix misc upstream packages

33 (self: super: let

34 pkgs = self.callPackage ({ pkgs }: pkgs) {};

35+ universeRepo = hackGet ./dep/universe;

35 in {

36 in {

36 hnix = pkgs.haskell.lib.dontCheck (self.callCabal2nix "hnix" (pkgs.fetchFromGitHub {

37 hnix = pkgs.haskell.lib.dontCheck (self.callCabal2nix "hnix" (pkgs.fetchFromGitHub {

37 owner = "haskell-nix";

38 owner = "haskell-nix";

@@ -39,14 +40,16 @@ let

39 rev = "42afdc21da5d9e076eab57eaa42bfdde938192b8";

40 rev = "42afdc21da5d9e076eab57eaa42bfdde938192b8";

40 sha256 = "0psw384dx9bw2dp93xrzw8rd9amvcwgzn64jzzwby7sfspj6k349";

41 sha256 = "0psw384dx9bw2dp93xrzw8rd9amvcwgzn64jzzwby7sfspj6k349";

41 }) {});

42 }) {});

42− # Need 8.0.2 build support

43+ universe = self.callCabal2nixWithOptions "universe" universeRepo "--subpath universe" {};

43− # PR: https://github.com/dmwit/universe/pull/33

44+ universe-base = self.callCabal2nixWithOptions "universe" universeRepo "--subpath universe-base" {};

44− universe-template = self.callCabal2nix "universe-template" (pkgs.fetchFromGitHub {

45+ universe-dependent-sum = pkgs.haskell.lib.doJailbreak (self.callCabal2nixWithOptions "universe" universeRepo "--subpath universe-dependent-sum" {});

45− owner = "obsidiansystems";

46+ universe-instances-extended = self.callCabal2nixWithOptions "universe" universeRepo "--subpath universe-instances-extended" {};

46− repo = "universe";

47+ universe-reverse-instances = self.callCabal2nixWithOptions "universe" universeRepo "--subpath universe-reverse-instances" {};

47− rev = "6a71119bfa5db2b9990a2491c941469ff8ef5d13";

48+ universe-instances-base = self.callCabal2nixWithOptions "universe" universeRepo "--subpath deprecated/universe-instances-base" {};

48− sha256 = "0z8smyainnlzcglv3dlx6x1n9j6d2jv48aa8f2421iayfkxg3js5";

49+ constraints-extras = self.callCabal2nix "constraints-extras" (hackGet ./dep/constraints-extras) {};

49− } + /template) {};

50+ dependent-map = self.callCabal2nix "dependent-map" (hackGet ./dep/dependent-map) {};

51+ dependent-sum = self.callCabal2nixWithOptions "dependent-sum" (hackGet ./dep/dependent-sum) "--subpath dependent-sum" {};

52+ dependent-sum-template = self.callCabal2nixWithOptions "dependent-sum-template" (hackGet ./dep/dependent-sum) "--subpath dependent-sum-template" {};

50 })

53 })

52 pkgs.obeliskExecutableConfig.haskellOverlay

55 pkgs.obeliskExecutableConfig.haskellOverlay

dep/reflex-platform/github.json+2−2

@@ -2,6 +2,6 @@

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4 "branch": "cg-bump-reflex-dom",

5− "rev": "35ce47d2d9a5de970a54cbe5e78d7431f688a995",

5+ "rev": "bb1de76a4ec855b6d8147acc4abc47a470ccd84a",

6− "sha256": "0pvz9853bhf4yy6d94r4jv0nxcj8ma07k9ysgn8zfl26ssmc4fh1"

6+ "sha256": "1insdz8m5a5dswflpcxn7hch1wvbxm58fzrbl41ifj66zqg7c34c"

lib/route/obelisk-route.cabal+3−2

@@ -8,10 +8,10 @@ library

8 build-depends: base,

9 categories,

10 constraints,

11+ constraints-extras,

11 containers,

12 containers,

12 dependent-map,

13 dependent-map,

13 dependent-sum,

14 dependent-sum,

14− dependent-sum-universe-orphans,

15 dependent-sum-template,

16 either,

17 ghcjs-dom,

@@ -28,9 +28,10 @@ library

28 reflex-dom-core,

29 template-haskell,

30 text,

31+ th-extras,

31 transformers,

32 transformers,

32 universe,

33 universe,

33− universe-template

34+ universe-dependent-sum

34 exposed-modules: Obelisk.Route

35 exposed-modules: Obelisk.Route

35 Obelisk.Route.TH

36 Obelisk.Route.TH

36 Obelisk.Route.Frontend

37 Obelisk.Route.Frontend

lib/route/src/Obelisk/Route.hs+23−22

@@ -113,13 +113,12 @@ import Data.Maybe

113import Data.Monoid ((<>))

114import Data.Set (Set)

115import qualified Data.Set as Set

116−import Data.Some (Some)

116+import Data.Some (Some(Some))

117−import qualified Data.Some as Some

118−import Data.Some.Universe.Orphans ()

119import Data.Text (Text)

117import Data.Text (Text)

120import qualified Data.Text as T

118import qualified Data.Text as T

121−import Data.Text.Encoding

119+import qualified Data.Text.Encoding as T

122import Data.Universe

120import Data.Universe

121+import Data.Universe.Some

123import Network.HTTP.Types.URI

122import Network.HTTP.Types.URI

124import qualified Numeric.Lens

123import qualified Numeric.Lens

125import Obelisk.Route.TH

124import Obelisk.Route.TH

@@ -155,7 +154,7 @@ pattern (:/) :: f a -> a -> R f

155pattern a :/ b = a :=> Identity b

154pattern a :/ b = a :=> Identity b

156

155

157mapSome :: (forall a. f a -> g a) -> Some f -> Some g

156mapSome :: (forall a. f a -> g a) -> Some f -> Some g

158−mapSome f (Some.This a) = Some.This $ f a

157+mapSome f (Some a) = Some $ f a

159

158

160hoistR :: (forall x. f x -> g x) -> R f -> R g

159hoistR :: (forall x. f x -> g x) -> R f -> R g

161hoistR f (x :=> Identity y) = f x :/ y

160hoistR f (x :=> Identity y) = f x :/ y

@@ -349,8 +348,8 @@ nothingEncoder = prismEncoder _Nothing

349

348

350someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

349someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

351someConstEncoder = unsafeMkEncoder $ EncoderImpl

350someConstEncoder = unsafeMkEncoder $ EncoderImpl

352− { _encoderImpl_encode = \(Some.This (Const a)) -> a

351+ { _encoderImpl_encode = \(Some (Const a)) -> a

353− , _encoderImpl_decode = pure . Some.This . Const

352+ , _encoderImpl_decode = pure . Some . Const

354 }

353 }

355

354

356-- | WARNING: This is only safe if the Show and Read instances for 'a' are

355-- | WARNING: This is only safe if the Show and Read instances for 'a' are

@@ -378,7 +377,7 @@ checkEnum1EncoderFunc

378 -> check (EncoderFunc check' parse p r)

377 -> check (EncoderFunc check' parse p r)

379checkEnum1EncoderFunc f = do

378checkEnum1EncoderFunc f = do

380 (encoderImpls :: DMap p (Flip (EncoderImpl parse) r)) <- DMap.fromList <$>

379 (encoderImpls :: DMap p (Flip (EncoderImpl parse) r)) <- DMap.fromList <$>

381− traverse (\(Some.This p) -> (p :=>) . Flip <$> unEncoder (f p)) universe

380+ traverse (\(Some p) -> (p :=>) . Flip <$> unEncoder (f p)) universe

382 pure $ EncoderFunc $ \p -> unsafeMkEncoder . unFlip $

381 pure $ EncoderFunc $ \p -> unsafeMkEncoder . unFlip $

383 DMap.findWithDefault (error "checkEnum1EncoderFunc: EncoderImpl not found (should be impossible)") p encoderImpls

382 DMap.findWithDefault (error "checkEnum1EncoderFunc: EncoderImpl not found (should be impossible)") p encoderImpls

384

383

@@ -433,11 +432,11 @@ chainEncoder cons this rest = Encoder $ do

433 pure $ EncoderImpl

432 pure $ EncoderImpl

434 { _encoderImpl_decode = \v -> do

433 { _encoderImpl_decode = \v -> do

435 (here, following) <- _encoderImpl_decode consValid v

434 (here, following) <- _encoderImpl_decode consValid v

436− Some.This r <- _encoderImpl_decode thisValid here

435+ Some r <- _encoderImpl_decode thisValid here

437 (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following

436 (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following

438 , _encoderImpl_encode = \(r :/ s) ->

437 , _encoderImpl_encode = \(r :/ s) ->

439 _encoderImpl_encode consValid

438 _encoderImpl_encode consValid

440− ( _encoderImpl_encode thisValid $ Some.This r

439+ ( _encoderImpl_encode thisValid $ Some r

441 , _encoderImpl_encode (runIdentity . unEncoder $ rest r) s)

440 , _encoderImpl_encode (runIdentity . unEncoder $ rest r) s)

442 }

441 }

443

442

@@ -504,7 +503,7 @@ enum1Encoder

504 , Show r

503 , Show r

505 )

504 )

506 => (forall a. p a -> r) -> Encoder check parse (Some p) r

505 => (forall a. p a -> r) -> Encoder check parse (Some p) r

507−enum1Encoder f = enumEncoder $ \(Some.This p) -> f p

506+enum1Encoder f = enumEncoder $ \(Some p) -> f p

508

507

509-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that

508-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that

510-- have a large number of values - it will use a lot of memory.

509-- have a large number of values - it will use a lot of memory.

@@ -596,10 +595,10 @@ queryParametersTextEncoder = Encoder $ pure $ EncoderImpl

596 in (urlDecodeText True k, urlDecodeText True <$> mv)

595 in (urlDecodeText True k, urlDecodeText True <$> mv)

597

596

598urlEncodeText :: Bool -> Text -> Text

597urlEncodeText :: Bool -> Text -> Text

599−urlEncodeText q = decodeUtf8 . urlEncode q . encodeUtf8

598+urlEncodeText q = T.decodeUtf8 . urlEncode q . T.encodeUtf8

600

599

601urlDecodeText :: Bool -> Text -> Text

600urlDecodeText :: Bool -> Text -> Text

602−urlDecodeText q = decodeUtf8 . urlDecode q . encodeUtf8

601+urlDecodeText q = T.decodeUtf8 . urlDecode q . T.encodeUtf8

603

602

604listToNonEmptyEncoder :: (Applicative check, Applicative parse, Monoid a, Eq a) => Encoder check parse [a] (NonEmpty a)

603listToNonEmptyEncoder :: (Applicative check, Applicative parse, Monoid a, Eq a) => Encoder check parse [a] (NonEmpty a)

605listToNonEmptyEncoder = Encoder $ pure $ EncoderImpl

604listToNonEmptyEncoder = Encoder $ pure $ EncoderImpl

@@ -711,9 +710,11 @@ data ObeliskRoute :: (* -> *) -> * -> * where

711 ObeliskRoute_App :: f a -> ObeliskRoute f a

710 ObeliskRoute_App :: f a -> ObeliskRoute f a

712 ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a

711 ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a

713

712

714−instance Universe (Some f) => Universe (Some (ObeliskRoute f)) where

713+instance UniverseSome f => UniverseSome (ObeliskRoute f) where

714+ universeSome = concat

715− universe = fmap (\(Some.This x) -> Some.This (ObeliskRoute_App x)) universe

715+ [ (\(Some x) -> Some (ObeliskRoute_App x)) <$> universe

716− ++ fmap (\(Some.This x) -> Some.This (ObeliskRoute_Resource x)) universe

716+ , (\(Some x) -> Some (ObeliskRoute_Resource x)) <$> universe

717+ ]

717

718

718instance GEq f => GEq (ObeliskRoute f) where

719instance GEq f => GEq (ObeliskRoute f) where

719 geq (ObeliskRoute_App x) (ObeliskRoute_App y) = geq x y

720 geq (ObeliskRoute_App x) (ObeliskRoute_App y) = geq x y

@@ -801,12 +802,12 @@ indexOnlyRouteEncoder = pathComponentEncoder indexOnlyRouteSegment

801

802

802someSumEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Sum a b)) (Either (Some a) (Some b))

803someSumEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Sum a b)) (Either (Some a) (Some b))

803someSumEncoder = Encoder $ pure $ EncoderImpl

804someSumEncoder = Encoder $ pure $ EncoderImpl

804− { _encoderImpl_encode = \(Some.This t) -> case t of

805+ { _encoderImpl_encode = \(Some t) -> case t of

805− InL l -> Left $ Some.This l

806+ InL l -> Left $ Some l

806− InR r -> Right $ Some.This r

807+ InR r -> Right $ Some r

807 , _encoderImpl_decode = pure . \case

808 , _encoderImpl_decode = pure . \case

808− Left (Some.This l) -> Some.This (InL l)

809+ Left (Some l) -> Some (InL l)

809− Right (Some.This r) -> Some.This (InR r)

810+ Right (Some r) -> Some (InR r)

810 }

811 }

811

812

812data Void1 :: * -> * where {}

813data Void1 :: * -> * where {}

@@ -817,7 +818,7 @@ instance Universe (Some Void1) where

817void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

818void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

818void1Encoder = Encoder $ pure $ EncoderImpl

819void1Encoder = Encoder $ pure $ EncoderImpl

819 { _encoderImpl_encode = \case

820 { _encoderImpl_encode = \case

820− Some.This f -> case f of {}

821+ Some f -> case f of {}

821 , _encoderImpl_decode = \_ -> throwError "void1Encoder: can't decode anything"

822 , _encoderImpl_decode = \_ -> throwError "void1Encoder: can't decode anything"

822 }

823 }

823

824

lib/route/src/Obelisk/Route/TH.hs+4−5

@@ -1,8 +1,9 @@

1module Obelisk.Route.TH (deriveRouteComponent) where

3+import Data.Constraint.Extras.TH

3import Data.GADT.Show.TH

4import Data.GADT.Show.TH

4import Data.GADT.Compare.TH

5import Data.GADT.Compare.TH

5−import Data.Universe.TH

6+import Data.Universe.Some.TH

6import Language.Haskell.TH

7import Language.Haskell.TH

8-- | Derive all the typeclasses needed for a RouteComponent type. The argument should be the name of a type of kind @k -> *@

9-- | Derive all the typeclasses needed for a RouteComponent type. The argument should be the name of a type of kind @k -> *@

@@ -11,8 +12,6 @@ deriveRouteComponent x = concat <$> traverse ($ x)

11 [ deriveGShow

12 [ deriveGShow

12 , deriveGEq

13 , deriveGEq

13 , deriveGCompare

14 , deriveGCompare

14− , deriveShowTagIdentity

15+ , deriveUniverseSome

15− , deriveEqTagIdentity

16+ , deriveArgDict

16− , deriveOrdTagIdentity

17− , deriveSomeUniverse

18 ]

17 ]