vinyl-operational (empty) → 0.1.1

raw patch · 4 files changed

+123/−0 lines, 4 filesdep +basedep +operationaldep +operational-extrasetup-changed

Dependencies added: base, operational, operational-extra, vinyl-plus

Files

LICENSE +30/−0
Setup.hs +2/−0
src/Data/Vinyl/Operational/Core.hs +61/−0
vinyl-operational.cabal +30/−0

+ LICENSE view

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

+ Setup.hs view

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

+ src/Data/Vinyl/Operational/Core.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Vinyl.Operational.Core where++import           Control.Monad+import           Control.Monad.Operational+import           Control.Monad.Operational.Interpret+import           Data.Vinyl.Types+import           Data.Vinyl.Optic.Plain.Class++coinstr :: RElem' instr rs => instr a -> ProgramT (FunctorCoRec rs) m a+coinstr instr = singleton (FunctorCoRec (clift (Flap instr)))++castProgramT :: (Monad m, RSubset' sub super) => ProgramT (FunctorCoRec sub) m a -> ProgramT (FunctorCoRec super) m a+castProgramT prog = mapProgramT (FunctorCoRec . ccast . getFunctorCoRec) prog++coliftProgramT :: (RElem' instr rs, Monad m) => ProgramT instr m a -> ProgramT (FunctorCoRec rs) m a+coliftProgramT = mapProgramT (FunctorCoRec . clift . Flap)++recApplyInstr :: Rec (ApplyInstr m) instrs -> FunctorCoRec instrs a -> m a+recApplyInstr (_ :& rnext) (FunctorCoRec (CoRecThere cnext)) =+  recApplyInstr rnext (FunctorCoRec cnext)+recApplyInstr (ApplyInstr f :& _) (FunctorCoRec (CoRecHere (Flap instr))) =+  f instr++recAroundInstr1 :: Rec (Around m) instrs -> FunctorCoRec instrs a -> m ()+recAroundInstr1 (_ :& rnext) (FunctorCoRec (CoRecThere cnext))+  = recAroundInstr1 rnext (FunctorCoRec cnext)+recAroundInstr1 (Around f :& rnext) (FunctorCoRec (CoRecHere (Flap instr)))+  = fst (f instr)++recAroundInstr2 :: Rec (Around m) instrs -> FunctorCoRec instrs a -> a -> m ()+recAroundInstr2 (_ :& rnext) (FunctorCoRec (CoRecThere cnext)) a+  = recAroundInstr2 rnext (FunctorCoRec cnext) a+recAroundInstr2 (Around f :& rnext) (FunctorCoRec (CoRecHere (Flap instr))) a+  = snd (f instr) a++cointerpretWithMonadT :: forall m instrs b. Monad m+  => Rec (ApplyInstr m) instrs -> ProgramT (FunctorCoRec instrs) m b -> m b+cointerpretWithMonadT interpreters = eval <=< viewT+  where+  eval :: forall a. ProgramViewT (FunctorCoRec instrs) m a -> m a+  eval (Return a) = return a+  eval (m :>>= k) = recApplyInstr interpreters m+                >>= cointerpretWithMonadT interpreters . k++cointerpretAroundMonadT :: forall m b instrs. Monad m+  => Rec (Around m) instrs+  -> Rec (ApplyInstr m) instrs+  -> ProgramT (FunctorCoRec instrs) m b+  -> m b+cointerpretAroundMonadT arounds interpreters = eval <=< viewT+  where+  eval :: forall a. ProgramViewT (FunctorCoRec instrs) m a -> m a+  eval (Return a) = return a+  eval (m@(FunctorCoRec c) :>>= k) = do+    recAroundInstr1 arounds m+    a <- recApplyInstr interpreters m+    recAroundInstr2 arounds m a+    cointerpretAroundMonadT arounds interpreters (k a)++

+ vinyl-operational.cabal view

@@ -0,0 +1,30 @@+name:                vinyl-operational+version:             0.1.1+synopsis:            Initial project template from stack+description:         Please see README.md+homepage:            http://github.com/andrewthad/vinyl-operational#readme+license:             BSD3+license-file:        LICENSE+author:              Andrew Martin+maintainer:          andrew.thaddeus@gmail.com+copyright:           2016 Andrew Martin+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Vinyl.Operational.Core+  build-depends:       base >= 4.7 && < 5+                     , vinyl-plus+                     , operational+                     , operational-extra+  default-language:    Haskell2010+  default-extensions:+    RankNTypes+    GADTs+    ScopedTypeVariables++source-repository head+  type:     git+  location: https://github.com/andrewthad/vinyl-operational