fmr (empty) → 0.1
raw patch · 5 files changed
+427/−0 lines, 5 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- fmr.cabal +40/−0
- src/Data/Field.hs +190/−0
- src/Data/Property.hs +165/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Andrey Mulik (c) 2020++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 Andrey Mulik 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fmr.cabal view
@@ -0,0 +1,40 @@+name: fmr+version: 0.1+category: Syntax++synopsis: Fake monadic records library+description: The generalized syntax of abstract monadic records.++author: Andrey Mulik+maintainer: <work.a.mulik@gmail.com>+bug-reports: https://github.com/andreymulik/fmr/issues++copyright: 2020 Andrey Mulik+license-file: LICENSE+license: BSD3++build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/andreymulik/fake-records++--- _ _____ ______ ______ ___ ______ __ __ ---+--- | | |_ _|| ___ \| ___ \ / _ \ | ___ \\ \ / / ---+--- | | | | | |_/ /| |_/ // /_\ \| |_/ / \ V / ---+--- | | | | | ___ \| / | _ || / \ / ---+--- | |____ _| |_ | |_/ /| |\ \ | | | || |\ \ | | ---+--- \_____/ \___/ \____/ \_| \_|\_| |_/\_| \_| \_/ ---++Library+ default-language: Haskell2010+ hs-source-dirs: src+ + build-depends: base >= 4.12 && < 5 + ghc-options: -Wall -Wcompat+ + exposed-modules:+ Data.Property+ Data.Field+
+ src/Data/Field.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE Safe, UndecidableInstances #-}++{- |+ License : BSD-style+ Module : Data.Field+ Copyright : (c) Andrey Mulik 2020+ Maintainer : work.a.mulik@gmail.com+ + @Data.Field@ provides fake field type for record-style operations.+-}+module Data.Field+(+ -- * Simple field+ SField (..), SOField, sfield,+ + -- * Field+ Field (..), OField,+ + -- * Observable field+ Observe (..), observe+)+where++import qualified Data.List as L++import Data.Property+import Data.Functor++default ()++--------------------------------------------------------------------------------++-- | Simple field, which contain only getter and setter.+data SField m record a = SField+ {+ -- | Get field value+ getSField :: !(record -> m a),+ -- | Set field value+ setSField :: !(record -> a -> m ())+ }++-- | 'Observe' 'SField'.+type SOField = Observe SField++instance GetProp SField record where getRecord = getSField+instance SetProp SField record where setRecord = setSField+instance ModifyProp SField record++instance (SwitchProp Field record) => SwitchProp SField record+ where+ switchRecord = switchRecord . toField+ incRecord = incRecord . toField+ decRecord = decRecord . toField++instance (InsertProp Field record many) => InsertProp SField record many+ where+ prependRecord x = prependRecord x . toField+ appendRecord x = appendRecord x . toField++instance (DeleteProp Field record many) => DeleteProp SField record many+ where+ deleteRecord x = deleteRecord x . toField++-- | Create 'Field' from getter and setter.+sfield :: (Monad m) => (record -> m a) -> (record -> a -> m ()) -> Field m record a+sfield g s = toField (SField g s)++toField :: (Monad m) => SField m record a -> Field m record a+toField field@(SField g s) = Field g s (modifyRecord field)++--------------------------------------------------------------------------------++-- | Normal field, which contain getter, setter and modifier.+data Field m record a = Field+ {+ -- | Get field value+ getField :: !(record -> m a),+ -- | Set field value+ setField :: !(record -> a -> m ()),+ -- | Modify field value+ modifyField :: !(record -> (a -> a) -> m a)+ }++-- | Observable 'Field'.+type OField = Observe Field++instance GetProp Field record where getRecord = getField+instance SetProp Field record where setRecord = setField+instance ModifyProp Field record where modifyRecord = modifyField++instance (Integral switch) => SwitchProp Field switch+ where+ incRecord field record = void $ modifyRecord field record succ+ decRecord field record = void $ modifyRecord field record pred+ + switchRecord field record = void . modifyRecord field record . (+) . fromIntegral++instance {-# INCOHERENT #-} SwitchProp Field Bool+ where+ incRecord record field = void $ modifyRecord record field not+ decRecord record field = void $ modifyRecord record field not+ + switchRecord record field n = void $ modifyRecord record field (even n &&)++instance InsertProp Field record []+ where+ appendRecord x record field = modifyRecord record field (++ [x])+ prependRecord x record field = modifyRecord record field (x :)++instance DeleteProp Field record []+ where+ deleteRecord x record field = modifyRecord record field (L.delete x)++--------------------------------------------------------------------------------++-- | Simple field observer, which can run some handlers after each action.+data Observe field m record a = Observe+ {+ -- | Field to observe.+ observed :: field m record a,+ -- | 'getRecord' observer+ onGet :: record -> a -> m (),+ -- | 'setRecord' observer+ onSet :: record -> a -> m (),+ -- | 'modifyRecord' observer+ onModify :: record -> m ()+ }++-- | Create field with default observers.+observe :: (Monad m) => field m record a -> Observe field m record a+observe field =+ let nothing = \ _ _ -> return ()+ in Observe field nothing nothing (\ _ -> return ())++instance (SwitchProp field a) => SwitchProp (Observe field) a+ where+ incRecord field record = do+ incRecord (observed field) record+ onModify field record+ + decRecord field record = do+ decRecord (observed field) record+ onModify field record+ + switchRecord field record n = do+ switchRecord (observed field) record n+ onModify field record++instance (GetProp field record) => GetProp (Observe field) record+ where+ getRecord field record = do+ res <- getRecord (observed field) record+ onGet field record res+ return res++instance (SetProp field record) => SetProp (Observe field) record+ where+ setRecord field record val = do+ setRecord (observed field) record val+ onSet field record val++instance (ModifyProp field record) => ModifyProp (Observe field) record+ where+ modifyRecord field record upd = do+ res <- modifyRecord (observed field) record upd+ onModify field record+ return res++instance (InsertProp field record many) => InsertProp (Observe field) record many+ where+ prependRecord x field record = do+ res <- prependRecord x (observed field) record+ onModify field record+ return res+ + appendRecord x field record = do+ res <- appendRecord x (observed field) record+ onModify field record+ return res++instance (DeleteProp field record many) => DeleteProp (Observe field) record many+ where+ deleteRecord x field record = do+ res <- deleteRecord x (observed field) record+ onModify field record+ return res+++
+ src/Data/Property.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE Safe, DefaultSignatures, GADTs, UndecidableInstances, BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}++{- |+ License : BSD-style+ Module : Data.Property+ Copyright : (c) Andrey Mulik 2020+ Maintainer : work.a.mulik@gmail.com+ + @Data.Property@ provides property type 'Prop' for record-style operations.+-}+module Data.Property+(+ -- * Property+ Prop (..), get, set, setProp,+ + -- ** Get+ GetProp (..),+ + -- ** Set+ SetProp (..),+ + -- ** Modify+ ModifyProp (..), InsertProp (..), DeleteProp (..), SwitchProp (..)+)+where++import Data.Functor++default ()++--------------------------------------------------------------------------------++-- | Property representation+data Prop m field record+ where+ -- | Increase property value (switch flag, increment, etc.).+ Incr :: (Monad m, SwitchProp field a) =>+ field m record a -> Prop m field record+ + -- | Decrease property value (switch flag, decrement, etc.).+ Decr :: (Monad m, SwitchProp field a) =>+ field m record a -> Prop m field record+ + -- | Increase/decrease value many times.+ Switch :: (Monad m, SwitchProp field a) =>+ field m record a -> Int -> Prop m field record+ + -- | @field ':=' val@ sets new value @val@ to record.+ (:=) :: (Monad m, SetProp field record) =>+ field m record a -> a -> Prop m field record+ + -- | @field '::=' upd@ - updates value using @upd@.+ (::=) :: (Monad m, SetProp field record) =>+ field m record a -> (record -> a) -> Prop m field record+ + -- | @field ':~' upd@ updates value using @upd@.+ (:~) :: (Monad m, ModifyProp field record) =>+ field m record a -> (a -> a) -> Prop m field record+ + -- | @field '::=' upd@ - updates value using @upd@.+ (::~) :: (Monad m, ModifyProp field record) =>+ field m record a -> (record -> a -> a) -> Prop m field record+ + -- | @field ':=+' val@ appends @val@ to @record@ value.+ (:=+) :: (Monad m, InsertProp field record many) =>+ field m record (many a) -> a -> Prop m field record+ + -- | @val ':=+' field@ prepends @val@ to @record@ value.+ (:+=) :: (Monad m, InsertProp field record many) =>+ a -> field m record (many a) -> Prop m field record+ + -- | @field ':~=' val@ removes @val@ from @record@ value+ (:~=) :: (Monad m, DeleteProp field record many, Eq a) =>+ field m record (many a) -> a -> Prop m field record++--------------------------------------------------------------------------------++-- | 'getRecord' shortcut.+get :: (Monad m, GetProp field record) => field m record a -> record -> m a+get = getRecord++-- | 'setProp' shortcut.+set :: (Monad m) => record -> [Prop m field record] -> m ()+set = setProp++-- | @setRecord record props@ changes @record@ value using @props@ properties.+setProp :: (Monad m) => record -> [Prop m field record] -> m ()+setProp record = mapM_ $ \ prop -> case prop of+ Incr field -> incRecord field record+ Decr field -> decRecord field record+ Switch field n -> switchRecord field record n+ + field ::= upd -> setRecord field record (upd record)+ field := val -> setRecord field record val+ field ::~ upd -> void $ modifyRecord field record (upd record)+ field :~ upd -> void $ modifyRecord field record upd+ + field :=+ val -> void $ prependRecord val field record+ val :+= field -> void $ appendRecord val field record+ field :~= val -> void $ deleteRecord val field record++--------------------------------------------------------------------------------++-- | Property getter.+class GetProp field record+ where+ -- | @'getRecord' field record@ return @record@'s value using @field@.+ getRecord :: (Monad m) => field m record a -> record -> m a++-- | Property setter.+class SetProp field record+ where+ -- | @'setRecord' field record value@ sets new @record@ @value@.+ setRecord :: (Monad m) => field m record a -> record -> a -> m ()++-- | Property modifier.+class ModifyProp field record+ where+ -- | @'modifyRecord' field record upd@ modifies @record@ @field@ using @upd@.+ default modifyRecord :: (Monad m, GetProp field record, SetProp field record) =>+ field m record a -> record -> (a -> a) -> m a+ modifyRecord :: (Monad m) => field m record a -> record -> (a -> a) -> m a+ modifyRecord field record f = do+ old <- get field record+ let new = f old+ setRecord field record new+ return new++--------------------------------------------------------------------------------++-- | Switch property modifier.+class SwitchProp field a+ where+ -- | Generalized increment, same as @switchRecord@.+ incRecord :: (Monad m) => field m record a -> record -> m ()+ + -- | Generalized decrement.+ decRecord :: (Monad m) => field m record a -> record -> m ()+ + {- |+ Increment/decrement many times.+ + > decRecord field record = switchRecord field record (-1)+ > incRecord field record = switchRecord field record 1+ -}+ switchRecord :: (Monad m) => field m record a -> record -> Int -> m ()++-- | Prepend/append modifier.+class InsertProp field record many+ where+ -- | Prepends new element to existing value.+ prependRecord :: (Monad m) => a -> field m record (many a) -> record -> m (many a)+ + -- | Appends new element to existing value.+ appendRecord :: (Monad m) => a -> field m record (many a) -> record -> m (many a)++-- | Delete modifier.+class DeleteProp field record many+ where+ -- | Delete element from value (if any).+ deleteRecord :: (Monad m, Eq a) => a -> field m record (many a) -> record -> m (many a)+++