diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2014, Nikita Volkov + +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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/focus.cabal b/focus.cabal new file mode 100644 --- /dev/null +++ b/focus.cabal @@ -0,0 +1,66 @@ +name: + focus +version: + 0.1.0 +synopsis: + A general abstraction for manipulating elements of container data structures +description: + An API for construction of free-form strategies of access and manipulation of + elements of arbitrary data structures. + It allows to implement efficient composite patterns, e.g., + a simultaneous update and lookup of an element, + and even more complex things. + . + Strategies are meant to be interpreted by the host data structure libraries. + Thus they allow to implement all access and modification patterns of + a data structure with just a single function, + which interprets strategies. + . + This library provides pure and monadic interfaces, + so it supports both immutable and mutable data structures. +category: + Containers, Data +homepage: + https://github.com/nikita-volkov/focus +bug-reports: + https://github.com/nikita-volkov/focus/issues +author: + Nikita Volkov +maintainer: + Nikita Volkov +copyright: + (c) 2014, Nikita Volkov +license: + MIT +license-file: + LICENSE +build-type: + Simple +cabal-version: + >=1.10 + + +source-repository head + type: + git + location: + git://github.com/nikita-volkov/focus.git + + +library + hs-source-dirs: + library + other-modules: + Focus.Prelude + exposed-modules: + Focus + build-depends: + -- debugging: + loch-th == 0.2.*, + placeholders == 0.1.*, + -- general: + base >= 4.5 && < 4.8 + default-extensions: + Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: + Haskell2010 diff --git a/library/Focus.hs b/library/Focus.hs new file mode 100644 --- /dev/null +++ b/library/Focus.hs @@ -0,0 +1,102 @@ +module Focus where + +import Focus.Prelude hiding (adjust, update, alter, insert, delete, lookup) + + +-- | +-- A general modification function for some match. +-- By processing a 'Maybe' value it produces some value to emit and +-- a 'Decision' to perform on the match. +-- +-- The interpretation of this function is up to the context APIs. +type Strategy a r = Maybe a -> (r, Decision a) + +-- | +-- A monadic version of 'Strategy'. +type StrategyM m a r = Maybe a -> m (r, Decision a) + +-- | +-- What to do with the focused value. +-- +-- The interpretation of the commands is up to the context APIs. +data Decision a = + Keep | + Remove | + Replace a + deriving (Functor) + + +-- * Constructors for common pure patterns +------------------------- + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +adjust :: (a -> a) -> Strategy a () +adjust f = maybe ((), Keep) (\a -> ((), Replace (f a))) + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +update :: (a -> Maybe a) -> Strategy a () +update f = maybe ((), Keep) (\a -> ((), maybe Remove Replace (f a))) + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +alter :: (Maybe a -> Maybe a) -> Strategy a () +alter f = ((),) . maybe Remove Replace . f + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +insert :: a -> Strategy a () +insert a = const ((), Replace a) + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +delete :: Strategy a () +delete = const ((), Remove) + +-- | +-- Reproduces the behaviour of +-- @Data.Map.@. +lookup :: Strategy a (Maybe a) +lookup r = (r, Keep) + + +-- * Constructors for monadic patterns +------------------------- + +-- | +-- A monadic version of 'adjust'. +adjustM :: (Monad m) => (a -> m a) -> StrategyM m a () +adjustM f = maybe (return ((), Keep)) (liftM (((),) . Replace) . f) + +-- | +-- A monadic version of 'update'. +updateM :: (Monad m) => (a -> m (Maybe a)) -> StrategyM m a () +updateM f = maybe (return ((), Keep)) (liftM (((),) . maybe Remove Replace) . f) + +-- | +-- A monadic version of 'alter'. +alterM :: (Monad m) => (Maybe a -> m (Maybe a)) -> StrategyM m a () +alterM f = liftM (((),) . maybe Remove Replace) . f + +-- | +-- A monadic version of 'insert'. +insertM :: (Monad m) => a -> StrategyM m a () +insertM = fmap return . insert + +-- | +-- A monadic version of 'delete'. +deleteM :: (Monad m) => StrategyM m a () +deleteM = fmap return delete + +-- | +-- A monadic version of 'lookup'. +lookupM :: (Monad m) => StrategyM m a (Maybe a) +lookupM = fmap return lookup + + diff --git a/library/Focus/Prelude.hs b/library/Focus/Prelude.hs new file mode 100644 --- /dev/null +++ b/library/Focus/Prelude.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE CPP #-} +module Focus.Prelude +( + module Exports, + bug, + bottom, + bool, +) +where + +-- base +------------------------- +import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.)) +import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) +import Control.Applicative as Exports +import Control.Arrow as Exports hiding (left, right) +import Control.Category as Exports +import Data.Monoid as Exports +import Data.Foldable as Exports +import Data.Traversable as Exports hiding (for) +import Data.Maybe as Exports +import Data.Either as Exports +import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') +import Data.Tuple as Exports +import Data.Function as Exports hiding ((.), id) +import Data.Ord as Exports (Down(..)) +import Data.String as Exports +import Data.Int as Exports +import Data.Word as Exports +import Data.Ratio as Exports +import Data.Bits as Exports +import Data.Fixed as Exports +import Data.Ix as Exports +import Data.Data as Exports +import Data.Bool as Exports hiding (bool) +import Text.Read as Exports (readMaybe, readEither) +import Control.Exception as Exports hiding (tryJust, try, assert) +import System.Mem as Exports +import System.Mem.StableName as Exports +import System.Timeout as Exports +import System.Exit as Exports +import System.IO.Unsafe as Exports +import System.IO as Exports (Handle, hClose) +import System.IO.Error as Exports +import Unsafe.Coerce as Exports +import GHC.Conc as Exports +import GHC.Generics as Exports (Generic) +import GHC.IO.Exception as Exports +import GHC.Exts as Exports (lazy, inline) +import Data.IORef as Exports +import Data.STRef as Exports +import Control.Monad.ST as Exports +import Debug.Trace as Exports hiding (traceM) + +-- placeholders +------------------------- +import Development.Placeholders as Exports + +-- custom +------------------------- +import qualified Debug.Trace.LocationTH + +bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |] + where + msg = "A \"focus\" package bug: " :: String + +bottom = [e| $bug "Bottom evaluated" |] + +bool :: a -> a -> Bool -> a +bool f _ False = f +bool _ t True = t + + +#if __GLASGOW_HASKELL__ < 708 + +instance Traversable ((,) a) where + traverse f (x, y) = (,) x <$> f y + +instance Foldable ((,) a) where + foldMap f (_, y) = f y + foldr f z (_, y) = f y z + +#endif +