15e81d6 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Merge remote-tracking branch 'origin/develop' into cg-bytestring-config

15e81d6Ali Abrar7 years ago

CONTRIBUTING.md+8

compare with master

unifiedsplit

@@ -49,6 +49,14 @@ You can run the tests like this:

49$(nix-build -A selftest --no-out-link)

50```

52+To test that your changes build across platforms, you can also try to build release.nix, like this:

53+```bash

54+nix-build release.nix

55+```

56+

57+Note, however, that to build release.nix you must accept the android license agreement and your machine must be configured to build both ios and android executables (usually via remote builders).

58+

59+

52### Documentation

60### Documentation

54#### In the code

62#### In the code

ChangeLog.md+2

@@ -7,6 +7,8 @@ This project's release branch is `master`. This log is written from the perspect

7* FrontendConfigsT and BackendConfigsT have been unified into ConfigsT and changes are made available via getConfig/getConfigs

8 * The frontend will still only have access to configs that are placed in config/frontend and config/common, while the backend has access to the entire contents of the config directory.

9 * You will need to use paths like "backend/clientSessionKey" to access a backend key for example, as there are no longer separate functions like getBackendConfig/getFrontendConfig.

10+* Add tabulation package. See Data.Tabulation for details.

11+* Add encoders for `DMap`, `HasFields` (cf. Data.Tabulation), and JSON.

11## v0.1.1.0 - 2019-05-17

13## v0.1.1.0 - 2019-05-17

default.nix+1

@@ -70,6 +70,7 @@ let

70 obelisk-route = self.callCabal2nix "obelisk-route" (cleanSource ./lib/route) {};

71 obelisk-selftest = self.callCabal2nix "obelisk-selftest" (cleanSource ./lib/selftest) {};

72 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};

73+ tabulation = self.callCabal2nix "tabulation" (cleanSource ./lib/tabulation) {};

73 })

74 })

75 (self: super: let

76 (self: super: let

lib/route/obelisk-route.cabal+3

@@ -6,6 +6,8 @@ build-type: Simple

6library

7 hs-source-dirs: src

8 build-depends: base,

9+ aeson,

10+ bytestring,

9 categories,

11 categories,

10 constraints,

12 constraints,

11 constraints-extras,

13 constraints-extras,

@@ -27,6 +29,7 @@ library

27 reflex,

29 reflex,

28 reflex-dom-core,

30 reflex-dom-core,

29 template-haskell,

31 template-haskell,

32+ tabulation,

30 text,

33 text,

31 th-extras,

34 th-extras,

32 transformers,

35 transformers,

lib/route/src/Obelisk/Route.hs+83−9

@@ -13,6 +13,7 @@

13{-# LANGUAGE RankNTypes #-}

14{-# LANGUAGE ScopedTypeVariables #-}

15{-# LANGUAGE TemplateHaskell #-}

16+{-# LANGUAGE TypeApplications #-}

16{-# LANGUAGE TypeFamilies #-}

17{-# LANGUAGE TypeFamilies #-}

17{-# LANGUAGE TypeOperators #-}

18{-# LANGUAGE TypeOperators #-}

18{-# LANGUAGE ViewPatterns #-}

19{-# LANGUAGE ViewPatterns #-}

@@ -85,6 +86,11 @@ module Obelisk.Route

85 , readShowEncoder

86 , readShowEncoder

86 , integralEncoder

87 , integralEncoder

87 , pathSegmentEncoder

88 , pathSegmentEncoder

89+ , queryOnlyEncoder

90+ , Decoder(..)

91+ , dmapEncoder

92+ , fieldMapEncoder

93+ , jsonEncoder

88 ) where

94 ) where

90import Prelude hiding ((.), id)

96import Prelude hiding ((.), id)

@@ -97,6 +103,7 @@ import Control.Category.Associative

97import Control.Category.Monoidal

103import Control.Category.Monoidal

98import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?), _Just, _Nothing, Iso', from, view, Wrapped (..))

104import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?), _Just, _Nothing, Iso', from, view, Wrapped (..))

99import Control.Monad.Except

105import Control.Monad.Except

106+import qualified Data.ByteString.Lazy as BSL

100import Data.Dependent.Sum (DSum (..))

107import Data.Dependent.Sum (DSum (..))

101import Data.Dependent.Map (DMap)

108import Data.Dependent.Map (DMap)

102import qualified Data.Dependent.Map as DMap

109import qualified Data.Dependent.Map as DMap

@@ -123,6 +130,9 @@ import Network.HTTP.Types.URI

123import qualified Numeric.Lens

130import qualified Numeric.Lens

124import Obelisk.Route.TH

131import Obelisk.Route.TH

125import Text.Read (readMaybe)

132import Text.Read (readMaybe)

133+import Data.Tabulation

134+import qualified Data.Aeson as Aeson

135+import Data.Aeson (FromJSON, ToJSON)

126

136

127-- Design goals:

137-- Design goals:

128-- No start-up time on the frontend (not yet met)

138-- No start-up time on the frontend (not yet met)

@@ -342,7 +352,7 @@ maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder

342justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

352justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

343justEncoder = prismEncoder _Just

353justEncoder = prismEncoder _Just

344

354

345−-- |

355+-- | Encode () to 'Nothing'.

346nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

356nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

347nothingEncoder = prismEncoder _Nothing

357nothingEncoder = prismEncoder _Nothing

348

358

@@ -546,13 +556,10 @@ pathOnlyEncoderIgnoringQuery = unsafeMkEncoder $ EncoderImpl

546 }

556 }

547

557

548pathOnlyEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse [Text] PageName

558pathOnlyEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse [Text] PageName

549−pathOnlyEncoder = unsafeMkEncoder $ EncoderImpl

559+pathOnlyEncoder = second (unitEncoder mempty) . coidr

550− { _encoderImpl_decode = \(path, query) ->

560+

551− if query == mempty

561+queryOnlyEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Map Text (Maybe Text)) PageName

552− then pure path

562+queryOnlyEncoder = first (unitEncoder []) . coidl

553− else throwError "pathOnlyEncoderImpl: query was provided"

554− , _encoderImpl_encode = \path -> (path, mempty)

555− }

556

563

557singletonListEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a [a]

564singletonListEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a [a]

558singletonListEncoder = unsafeMkEncoder $ EncoderImpl

565singletonListEncoder = unsafeMkEncoder $ EncoderImpl

@@ -867,7 +874,6 @@ renderObeliskRoute e r =

867readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) => Encoder check parse a PageName

874readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) => Encoder check parse a PageName

868readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

875readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

869

876

870−

871integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

877integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

872integralEncoder = prismEncoder (Numeric.Lens.integral)

878integralEncoder = prismEncoder (Numeric.Lens.integral)

873

879

@@ -880,4 +886,72 @@ pathSegmentEncoder = unsafeMkEncoder EncoderImpl

880 (x:xs) -> pure (x, (xs, y))

886 (x:xs) -> pure (x, (xs, y))

881 }

887 }

882

888

889+newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

890+

891+dmapEncoder :: forall check parse k k' v.

892+ ( Monad check

893+ , MonadError Text parse

894+ , Universe (Some k')

895+ , Ord k

896+ , GCompare k'

897+ , GShow k'

898+ )

899+ => Encoder check parse (Some k') k

900+ -> (forall v'. k' v' -> Encoder check parse v' v)

901+ -> Encoder check parse (DMap k' Identity) (Map k v)

902+dmapEncoder keyEncoder' valueEncoderFor = unsafeEncoder $ do

903+ keyEncoder :: Encoder Identity parse (Some k') k <- checkEncoder keyEncoder'

904+ valueDecoders :: DMap k' (Decoder Identity parse v) <- fmap DMap.fromList . forM universe $ \(Some.This (k' :: k' t)) -> do

905+ ve :: Encoder Identity parse t v <- checkEncoder (valueEncoderFor k')

906+ return $ (k' :: k' t) :=> (Decoder ve :: Decoder Identity parse v t)

907+ let keyError k = "dmapEncoder: key `" <> k <> "' was missing from the Universe instance for its type."

908+ return $ EncoderImpl

909+ { _encoderImpl_encode = \dm -> Map.fromList $ do

910+ ((k' :: k' t) :=> Identity v') <- DMap.toList dm

911+ return ( encode keyEncoder (Some.This k')

912+ , encode (toEncoder (DMap.findWithDefault (error . keyError $ gshow k') k' valueDecoders)) v'

913+ )

914+ , _encoderImpl_decode = \m -> fmap DMap.fromList . forM (Map.toList m) $ \(k,v) -> do

915+ Some.This (k' :: k' t) <- tryDecode keyEncoder k

916+ case DMap.lookup k' valueDecoders of

917+ Nothing -> throwError . T.pack . keyError $ gshow k'

918+ Just (Decoder e) -> do

919+ v' <- tryDecode e v

920+ return (k' :=> Identity v')

921+ }

922+

923+fieldMapEncoder :: forall check parse r.

924+ ( Applicative check

925+ , MonadError Text parse

926+ , HasFields r

927+ , Universe (Some (Field r))

928+ , GShow (Field r)

929+ , GCompare (Field r)

930+ )

931+ => Encoder check parse r (DMap (Field r) Identity)

932+fieldMapEncoder = unsafeEncoder $ do

933+ pure $ EncoderImpl

934+ { _encoderImpl_encode = \r -> DMap.fromList [ f :=> Identity (indexField r f) | Some.This f <- universe ]

935+ , _encoderImpl_decode = \dm -> tabulateFieldsA $ \f -> do

936+ case DMap.lookup f dm of

937+ Nothing -> throwError $ "fieldMapEncoder: Couldn't find key for `" <> T.pack (gshow f) <> "' in DMap."

938+ Just (Identity v) -> return v

939+ }

940+

941+-- | Use ToJSON/FromJSON to encode to Text. The correctness of this encoder is dependent on the encoding being injective and round-tripping correctly.

942+jsonEncoder :: forall check parse r.

943+ ( ToJSON r

944+ , FromJSON r

945+ , Applicative check

946+ , MonadError Text parse

947+ )

948+ => Encoder check parse r Text

949+jsonEncoder = unsafeEncoder $ do

950+ pure $ EncoderImpl

951+ { _encoderImpl_encode = \r -> decodeUtf8 . BSL.toStrict $ Aeson.encode r

952+ , _encoderImpl_decode = \t -> case Aeson.eitherDecodeStrict $ encodeUtf8 t of

953+ Left err -> throwError ("jsonEncoder: " <> T.pack err)

954+ Right x -> return x

955+ }

956+

883--TODO: decodeURIComponent as appropriate

957--TODO: decodeURIComponent as appropriate

lib/selftest/src/Obelisk/SelfTest.hs+2−1

@@ -129,7 +129,8 @@ main = do

129

130 it "produces a valid route config" $ inTmpObInit $ \tmp -> liftIO $ do

131 configs <- getConfigs

132− withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ getConfigRoute configs `shouldNotReturn` Nothing

132+ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $

133+ return (either (const Nothing) Just $ getConfigRoute configs) `shouldNotReturn` Nothing

133

134

134 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"

135 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"

135 -- when not run by 'nix-build --attr selftest'

136 -- when not run by 'nix-build --attr selftest'

lib/tabulation/CHANGELOG.mdnew file+5

@@ -0,0 +1,5 @@

1+# Revision history for tabulation

3+## 0.1.0.0 -- 2019-05-24

5+* First version. Basically carve out this library as a place for the HasFields class.

lib/tabulation/LICENSEnew file+30

@@ -0,0 +1,30 @@

5+Redistribution and use in source and binary forms, with or without

6+modification, are permitted provided that the following conditions are met:

8+ * Redistributions of source code must retain the above copyright

9+ notice, this list of conditions and the following disclaimer.

10+

11+ * Redistributions in binary form must reproduce the above

12+ copyright notice, this list of conditions and the following

13+ disclaimer in the documentation and/or other materials provided

14+ with the distribution.

15+

16+ * Neither the name of Cale Gibbard nor the names of other

17+ contributors may be used to endorse or promote products derived

18+ from this software without specific prior written permission.

19+

20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

lib/tabulation/Setup.hsnew file+2

@@ -0,0 +1,2 @@

1+import Distribution.Simple

2+main = defaultMain

lib/tabulation/src/Data/Tabulation.hsnew file+21

@@ -0,0 +1,21 @@

1+{-# LANGUAGE TypeFamilies #-}

2+{-# LANGUAGE RankNTypes #-}

4+module Data.Tabulation where

6+import Control.Lens

8+-- | This is a class for record types whose fields can be enumerated by an associated GADT. It's closely related to the concept of a representable functor, except without the functor part, and the fields are not all the same type.

9+class HasFields a where

10+ type Field a :: * -> *

11+

12+ fieldLens :: Field a x -> Lens' a x

13+ tabulateFieldsA :: Applicative f => (forall x. Field a x -> f x) -> f a

14+

15+ tabulateFields :: (forall x. Field a x -> x) -> a

16+ tabulateFields f = runIdentity (tabulateFieldsA (Identity . f))

17+ traverseWithField :: Applicative m => (forall x. Field a x -> x -> m x) -> a -> m a

18+ traverseWithField t r = tabulateFieldsA (\f -> t f (indexField r f))

19+ indexField :: a -> Field a x -> x

20+ indexField a f = a ^. fieldLens f

21+ {-# MINIMAL fieldLens, tabulateFieldsA #-}

lib/tabulation/tabulation.cabalnew file+26

@@ -0,0 +1,26 @@

1+cabal-version: >=1.10

2+-- Initial package description 'tabulation.cabal' generated by 'cabal

3+-- init'. For further documentation, see

4+-- http://haskell.org/cabal/users-guide/

6+name: tabulation

7+version: 0.1.0.0

8+synopsis: A library for types that can be completely reconstructed by fields as specified by a GADT.

9+-- description:

10+-- bug-reports:

11+license: BSD3

12+license-file: LICENSE

13+author: Cale Gibbard

14+maintainer: cale.gibbard@obsidian.systems

15+-- copyright:

16+category: Data

17+build-type: Simple

18+extra-source-files: CHANGELOG.md

19+

20+library

21+ exposed-modules: Data.Tabulation

22+ -- other-modules:

23+ -- other-extensions:

24+ build-depends: base, lens

25+ hs-source-dirs: src

26+ default-language: Haskell2010

release.nix+4−1

@@ -61,7 +61,10 @@ let

61 ];

62 command = local-self.command;

63 serverExeSkeleton = (import ./skeleton { obelisk = local-self; }).exe;

64+ androidObelisk = import ./. (self-args // {

65+ config.android_sdk.accept_license = true;

66+ });

64− androidSkeleton = (import ./skeleton { obelisk = local-self; }).android.frontend;

67+ androidSkeleton = (import ./skeleton { obelisk = androidObelisk; }).android.frontend;

65 iosObelisk = import ./. (self-args // {

68 iosObelisk = import ./. (self-args // {

66 system = "x86_64-darwin";

69 system = "x86_64-darwin";

67 iosSdkVersion = "10.2";

70 iosSdkVersion = "10.2";