diff --git a/pkg/hs/stack.yaml b/pkg/hs/stack.yaml index c18632ee3..e767dc5b8 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -7,6 +7,8 @@ packages: - urbit-atom - urbit-azimuth - urbit-king + - urbit-noun + - urbit-noun-core extra-deps: - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38 diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 3b2d74df0..51f7ba5a2 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -60,7 +60,7 @@ Polish: - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. - [ ] Spin off `RAcquire` into it's own package. -- [ ] Spin off `Urbit.Noun` into it's own package. +- [x] Spin off `urbit-noun-core` and `urbit-noun` packages. - [ ] Spin off `Urbit.Vere.Log` into it's own package. - [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care less about the shape of events and effects. diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs index e5c9be159..1f3ef9d50 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs @@ -3,8 +3,8 @@ -} module Urbit.Arvo.Effect where +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Arvo.Common (KingId(..), ServId(..)) import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs index 020cab13e..75cb6fcf3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs @@ -10,7 +10,7 @@ import Urbit.Prelude import Data.Conduit import Urbit.Arvo -import Urbit.Time +import Urbit.Noun.Time import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe (MaybeT(..)) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 25fd34007..6eeed7dd4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -96,7 +96,7 @@ import Urbit.King.App (killKingActionL, onKillKingSigL) import Urbit.King.App (killPierActionL) import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) import Urbit.Noun.Conversions (cordToUW) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import Urbit.Vere.LockFile (lockFile) import qualified Data.Set as Set diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs index f6e5bd763..f16f6a55a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs @@ -64,9 +64,9 @@ import Urbit.Prelude import Network.Socket hiding (recvFrom, sendTo) import Urbit.Arvo hiding (Fake) -import qualified Data.Map as M -import qualified Urbit.Ob as Ob -import qualified Urbit.Time as Time +import qualified Data.Map as M +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Ob as Ob -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 936d470a6..5facb8001 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -8,12 +8,12 @@ import Urbit.Arvo hiding (Behn) import Urbit.Prelude import Urbit.Vere.Pier.Types -import Urbit.King.App (HasPierEnv(..), HasKingId(..)) -import Urbit.Time (Wen) -import Urbit.Timer (Timer) +import Urbit.King.App (HasKingId(..), HasPierEnv(..)) +import Urbit.Noun.Time (Wen) +import Urbit.Timer (Timer) -import qualified Urbit.Time as Time -import qualified Urbit.Timer as Timer +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Timer as Timer -- Behn Stuff ------------------------------------------------------------------ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index bb7dfd22a..06fc38b56 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -28,7 +28,7 @@ import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -40,7 +40,7 @@ import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent import qualified Urbit.King.API as King -import qualified Urbit.Time as Time +import qualified Urbit.Noun.Time as Time import qualified Urbit.Vere.Log as Log import qualified Urbit.Vere.Serf as Serf import qualified Urbit.Vere.Term as Term diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 350c6b9f3..5136041d8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -20,7 +20,7 @@ where import Urbit.Prelude hiding (Term) import Urbit.Arvo -import Urbit.Time +import Urbit.Noun.Time import Urbit.Vere.Serf.Types diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index c9302490a..100b68a56 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -79,12 +79,12 @@ import Foreign.Storable (peek, poke) import RIO.Prelude (decodeUtf8Lenient) import System.Posix.Signals (sigKILL, signalProcess) import Urbit.Arvo (Ev, FX) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified System.IO.Error as IO -import qualified Urbit.Time as Time +import qualified Urbit.Noun.Time as Time -- Serf API -------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs index 7949a1524..7d772a30d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -2,8 +2,8 @@ module Urbit.Vere.Serf.Types where import Urbit.Prelude -import Urbit.Arvo (Ev, FX) -import Urbit.Time (Wen) +import Urbit.Arvo (Ev, FX) +import Urbit.Noun.Time (Wen) -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 7fe9bb2b1..d36ad0582 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -18,8 +18,8 @@ import RIO.FilePath import System.Posix.IO import System.Posix.Terminal import Urbit.Arvo hiding (Term) +import Urbit.Noun.Time import Urbit.Prelude hiding (getCurrentTime) -import Urbit.Time import Urbit.Vere.Pier.Types import Data.List ((!!)) diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index 3128109bd..ca46db559 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -99,6 +99,8 @@ dependencies: - unliftio-core - unordered-containers - urbit-atom + - urbit-noun + - urbit-noun-core - urbit-azimuth - urbit-hob - utf8-string diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index d254abe4f..13e67546e 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -10,8 +10,8 @@ import Test.Tasty.TH import Urbit.Arvo import Urbit.King.Config import Urbit.Noun +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Ames import Urbit.Vere.Log import Urbit.Vere.Pier.Types @@ -73,36 +73,38 @@ runNetworkApp = runRIO NetworkTestApp } runGala - :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue EvErr, EffCb e NewtEf) + :: forall e + . HasAmes e + => Word8 + -> RAcquire e (TQueue EvErr, NewtEf -> IO ()) runGala point = do env <- ask que <- newTQueueIO let (_, runAmes) = ames env (fromIntegral point) True (writeTQueue que) noStderr cb <- runAmes - rio $ cb turfEf + io (cb turfEf) pure (que, cb) where noStderr _ = pure () waitForPacket :: TQueue EvErr -> Bytes -> IO Bool waitForPacket q val = go - where - go = - atomically (readTQueue q) >>= \case - EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go - EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val) - _ -> pure False + where + go = atomically (readTQueue q) >>= \case + EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go + EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val) + _ -> pure False runRAcquire :: RAcquire e a -> RIO e a runRAcquire acq = rwith acq pure -sendThread :: EffCb e NewtEf -> (Galaxy, Bytes) -> RAcquire e () +sendThread :: (NewtEf -> IO ()) -> (Galaxy, Bytes) -> RAcquire e () sendThread cb (to, val) = void $ mkRAcquire start cancel where start = async $ forever $ do threadDelay 1_000 wen <- io $ now - cb (sendEf to wen val) + io $ cb (sendEf to wen val) threadDelay 10_000 zodSelfMsg :: Property diff --git a/pkg/hs/urbit-king/test/ArvoTests.hs b/pkg/hs/urbit-king/test/ArvoTests.hs index 7dac215a3..6ee235746 100644 --- a/pkg/hs/urbit-king/test/ArvoTests.hs +++ b/pkg/hs/urbit-king/test/ArvoTests.hs @@ -10,8 +10,8 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Log import Urbit.Vere.Pier.Types diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index 40d5c2178..c207a71e6 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -10,8 +10,8 @@ import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo import Urbit.Noun +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Behn import Urbit.Vere.Log import Urbit.Vere.Pier.Types @@ -22,8 +22,8 @@ import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) import Urbit.King.App (runKingEnvNoLog, HasKingId(..)) -import qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Vere.Log as Log -------------------------------------------------------------------------------- @@ -38,7 +38,7 @@ timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest) king <- fromIntegral <$> view kingIdL q <- newTQueueIO rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do - cb (BehnEfDoze (king, ()) (Just (2^20))) + io $ cb (BehnEfDoze (king, ()) (Just (2^20))) t <- atomically $ readTQueue q pure True diff --git a/pkg/hs/urbit-noun-core/.gitignore b/pkg/hs/urbit-noun-core/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/urbit-noun-core/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/urbit-noun-core/LICENSE b/pkg/hs/urbit-noun-core/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-noun-core/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Convert.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Convert.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Convert.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Convert.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Core.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Core.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Core.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Core.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Cue.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Cue.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Cue.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Cue.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Jam.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Jam.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Jam.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Jam.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/TH.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/TH.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs diff --git a/pkg/hs/urbit-noun-core/package.yaml b/pkg/hs/urbit-noun-core/package.yaml new file mode 100644 index 000000000..f9fee3374 --- /dev/null +++ b/pkg/hs/urbit-noun-core/package.yaml @@ -0,0 +1,71 @@ +name: urbit-noun-core +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - QuickCheck + - ghc-prim + - hashable + - urbit-atom + - classy-prelude + - bytestring + - hashtables + - vector + - integer-gmp + - template-haskell + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns diff --git a/pkg/hs/urbit-noun/.gitignore b/pkg/hs/urbit-noun/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/urbit-noun/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/urbit-noun/LICENSE b/pkg/hs/urbit-noun/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-noun/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Tank.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Tank.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Time.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs similarity index 99% rename from pkg/hs/urbit-king/lib/Urbit/Time.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs index a33fd982a..55122fcb3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Time.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs @@ -2,7 +2,7 @@ TODO This is slow. -} -module Urbit.Time where +module Urbit.Noun.Time where import Control.Lens import Prelude diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Tree.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tree.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Tree.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Tree.hs diff --git a/pkg/hs/urbit-noun/package.yaml b/pkg/hs/urbit-noun/package.yaml new file mode 100644 index 000000000..d94be31f6 --- /dev/null +++ b/pkg/hs/urbit-noun/package.yaml @@ -0,0 +1,73 @@ +name: urbit-noun +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - classy-prelude + - ghc-prim + - largeword + - lens + - murmur3 + - regex-tdfa + - regex-tdfa-text + - rio + - text + - time + - urbit-atom + - urbit-noun-core + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns