boop (empty) → 0.1.0.0

raw patch · 9 files changed

+291/−0 lines, 9 filesdep +basedep +boopdep +mtlsetup-changed

Dependencies added: base, boop, mtl, text

Files

• LICENSE +30/−0
• README.md +7/−0
• Setup.hs +2/−0
• boop.cabal +45/−0
• src/Control/OOP.hs +31/−0
• src/Control/OOP/Base.hs +76/−0
• src/Control/OOP/Interfaces/ToString.hs +51/−0
• src/Control/OOP/MonadVar.hs +47/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,30 @@+Copyright Tobias Dammers (c) 2017++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 Author name here 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.

@@ -0,0 +1,7 @@+# boop++BOOP is Basic Object-Oriented Programming. Given just a few relatively simple+primitives, BOOP enables fully fledged object-oriented programming in Haskell.++For details, refer to+https://programming.tobiasdammers.nl/blog/2017-10-17-object-oriented-haskell.

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

@@ -0,0 +1,45 @@+name:           boop+category:       OOP+synopsis:       OOP primitives for Haskell+version:        0.1.0.0+homepage:       https://github.com/tdammers/boop+bug-reports:    https://github.com/tdammers/boop/issues+author:         Tobias Dammers+maintainer:     tdammers@gmail.com+copyright:      2017 Tobias Dammers+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/tdammers/boop++library+  hs-source-dirs:+      src+  build-depends:+      base >= 4.7 && < 5+    , text+    , mtl+  exposed-modules:+      Control.OOP+    , Control.OOP.Base+    , Control.OOP.Interfaces.ToString+    , Control.OOP.MonadVar+  default-language: Haskell2010++test-suite boop-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >= 4.7 && < 5+    , boop+  default-language: Haskell2010

@@ -0,0 +1,31 @@+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE TypeOperators #-}+{-#LANGUAGE RankNTypes #-}++module Control.OOP+(+-- * Classes, Methods, and Interfaces+  (:>) (..)++-- * Properties / Fields / Methods+, member+, imember+, pureMember+, mapMember+, (-->)+, (==>)++-- * Mutable State+, MonadConstVar (..)+, MonadVar (..)++-- * Standard interfaces+, ToString (..)+)+where++import Control.OOP.Base+import Control.OOP.MonadVar+import Control.OOP.Interfaces.ToString

@@ -0,0 +1,76 @@+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE TypeOperators #-}+{-#LANGUAGE RankNTypes #-}++module Control.OOP.Base+where++-- | The instance-of typeclass. @a :> b@ means that @a@ is an instance of @b@.+class a :> b where+  cast :: a -> b++-- | Every interface is trivially an instance of itself.+instance a :> a where+  cast = id++-- | Member accessor: get an object member through an interface.+member :: cls :> inst+     => (inst -> inst -> a)+     -> cls+     -> a+member p obj =+  imember p (cast obj)++imember :: (inst -> inst -> a)+        -> inst+        -> a+imember p vt =+  p vt vt++-- | Applicative accessor for a pure member.+pureMember :: (cls :> inst, Applicative m)+         => (inst -> inst -> a)+         -> cls+         -> m a+pureMember p = pure . member p++-- | Accessing a pure member through a 'Functor'+mapMember :: (cls :> inst, Functor m)+         => (inst -> inst -> a)+         -> m cls+         -> m a+mapMember p = fmap (member p)++-- | Flipped operator alias for 'member'.+(-->) :: cls :> inst+      => cls+      -> (inst -> inst -> a)+      -> a+(-->) = flip member+infixl 8 -->++-- | Flipped operator alias for 'imember'.+(==>) :: inst+      -> (inst -> inst -> a)+      -> a+(==>) = flip imember+infixl 8 ==>++-- | Flipped operator alias for 'pureMember'.+(-->>) :: (cls :> inst, Applicative m)+      => cls+      -> (inst -> inst -> a)+      -> m a+(-->>) = flip pureMember+infixl 8 -->>++-- | Flipped operator alias for 'mapMember'.+(>-->) :: (cls :> inst, Functor m)+      => m cls+      -> (inst -> inst -> a)+      -> m a+(>-->) = flip mapMember+infixl 8 >-->+

@@ -0,0 +1,51 @@+{-#LANGUAGE TypeOperators #-}+{-#LANGUAGE TypeSynonymInstances #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}++module Control.OOP.Interfaces.ToString+where++import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import Control.Monad.Identity (Identity, runIdentity)++import Control.OOP.Base++type LText = LText.Text++-- | Objects that can be converted to string+data ToString m+  = ToString+      { -- | Monadically cast an object to `Text`.+        toStringM :: ToString m -> m Text+      }++-- | Cast an object to `Text` in a pure context.+toString :: ToString Identity -> ToString Identity -> Text+toString a b = runIdentity $ toStringM a b++castShow :: (Applicative m, Show a) => a -> ToString m+castShow = cast . show++instance Applicative m => Text :> ToString m where+  cast x = ToString (const . pure $ x)++instance Applicative m => LText :> ToString m where+  cast x = ToString (const . pure $ LText.toStrict x)++instance Applicative m => String :> ToString m where+  cast x = ToString (const . pure $ Text.pack x)++instance Applicative m => Int :> ToString m where+  cast = castShow++instance Applicative m => Integer :> ToString m where+  cast = castShow++instance Applicative m => Double :> ToString m where+  cast = castShow++instance Applicative m => Rational :> ToString m where+  cast = castShow

@@ -0,0 +1,47 @@+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE TypeOperators #-}+{-#LANGUAGE FunctionalDependencies #-}++module Control.OOP.MonadVar+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Proxy++-- | Generalized read-only access to mutable variables+class Monad m => MonadConstVar v m | m -> v where+  readVar :: v a -> m a++-- | Generalized mutable variables+class (Monad m, MonadConstVar v m) => MonadVar v m | m -> v where+  newVar :: a -> m (v a)+  writeVar :: a -> v a -> m ()++  modifyVar :: (a -> a) -> v a -> m ()+  swapVar :: a -> v a -> m a+  modifySwapVar :: (a -> a) -> v a -> m a++  transaction :: Proxy v -> m a -> m a++  modifyVar f var =+    modifySwapVar f var >> return ()++  swapVar val' =+    modifySwapVar (const val')++  modifySwapVar f var = do+    val <- readVar var+    writeVar (f val) var+    return val++instance MonadIO m => MonadConstVar IORef m where+  readVar = liftIO . readIORef+  +instance MonadIO m => MonadVar IORef m where+  newVar = liftIO . newIORef+  writeVar v = liftIO . flip writeIORef v+  transaction _ = id+

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"