packages feed

Focus (empty) → 0.1

raw patch · 5 files changed

+201/−0 lines, 5 filesdep +MissingHdep +basedep +splitsetup-changed

Dependencies added: MissingH, base, split

Files

+ Focus.cabal view
@@ -0,0 +1,28 @@+Name:          Focus+Version:       0.1+License:       MIT+License-file:  LICENSE+Category:      Data+Synopsis:      Tools for focusing in on locations within numbers+Description:   Focuses are lists of numbers where longer lists are treated as+               'focuses' on their parent lists. As such, `Focus []` is+               considered "unfocused" (it is EQ to all focuses), `Focus [1, 1]`+               is EQ to `Focus [1, 1, 3]` because their roots are equal, and so+               on. This isn't useful for testing true equality, but it is quite+               useful for traversing and pruning indexed rose trees from one+               locus to another.+Author:        Nate Soares+Maintainer:    nate@natesoares.com+Build-Type:    Simple+Cabal-Version: >=1.6++source-repository head+    type: git+    location: git://github.com/Soares/Focus.hs.git++Library+    Hs-Source-Dirs:   src+    Build-Depends:    base >= 4 && < 5, MissingH >= 1.0, split >= 0.1+    Exposed-modules:  Data.Focus, Data.Scope+    Ghc-Options:      -Wall+    Ghc-Prof-Options: -auto-all
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright © 2011 Nathaniel Soares++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Focus.hs view
@@ -0,0 +1,115 @@+module Data.Focus+    ( Focus+    , toList+    , fromList+    , fromString+    , parse+    , split+    , strip+    , focus+    , contract+    , retract+    , unfocused+    ) where++import Control.Arrow ( first )+import Data.List ( intercalate )+import Data.List.Split ( splitOn )+import Data.String.Utils ( lstrip )++data Focus = Focus { _list :: [Int] }+instance Eq Focus where x == y = common x y == common y x+instance Ord Focus where xs <= ys = common xs ys <= common ys xs++common :: Focus -> Focus -> [Int]+common xs ys = take enough $ toList xs+    where enough = min (length $ toList xs) (length $ toList ys)+++-- | Reading and Showing++instance Show Focus where+    show (Focus xs) = "<" ++ intercalate "|" (map show xs) ++ ">"++instance Read Focus where+    readsPrec _ s = [(Focus xs, rest) | ("<", s')      <- lex s+                                      , (xs, '>':rest) <- readInts s']+        where readInts t = [(x : xs, rest) | (x, t')    <- reads t+                                           , ("|", t'') <- lex t'+                                           , (xs, rest) <- readInts t'']+                           ++ map (first return) (reads t)+++-- | Behavior++focus :: Focus -> Focus -> Focus+focus (Focus xs) (Focus ys) = Focus $ xs ++ ys++contract :: Focus -> Int -> Focus+contract (Focus xs) x = Focus $ xs ++ [x]++retract :: Focus -> Focus+retract (Focus []) = unfocused+retract (Focus xs) = Focus $ init xs++unfocused :: Focus+unfocused = fromList []+++-- | Creation++toList :: Focus -> [Int]+toList = _list++fromList :: [Int] -> Focus+fromList = Focus++fromString :: String -> Maybe Focus+fromString = fst . split+++-- | Parsing++separators :: String+separators = " .,;:|-_"++split :: String -> (Maybe Focus, String)+split str = split' $ parse str where+    split' [] = (Nothing, str)+    split' ((f, (s:ss)):_) | s `elem` separators = (Just f, ss)+    split' ((f, s):_) = (Just f, s)++strip :: String -> String+strip = snd . split++parse :: ReadS Focus+parse s = [(Focus xs, rest) | (xs, rest) <- parseInts s]+++-- | Parser helpers++parseInts :: ReadS [Int]+parseInts s = separated ++ spaced ++ single where+    separated = [(x : xs, rest) | (x, s')    <- parseInt s+                                , (_, s'')   <- parseSep s'+                                , (xs, rest) <- parseInts s'']+    spaced    = [(x : xs, rest) | (x, s')    <- parseInt s+                                , (xs, rest) <- parseInts s' ]+    single    = [([x], rest)    | (x, rest)  <- parseInt s   ]++parseInt :: ReadS Int+parseInt s = [(x, rest'++rest) | (tok, rest) <- dotlex s+                               , (x, rest')  <- reads tok]++parseSep :: ReadS String+parseSep s = [(sep, rest) | (sep, rest) <- dotlex s+                          , sep `elem` map return separators]++-- A version of 'lex' that splits on dots as well, allowing us to parse+-- something like "1.2.3" as multiple numbers+dotlex :: ReadS String+dotlex = dotlex' . lstrip where+    dotlex' ('.' : s) = [(".", s)]+    dotlex' s = [(a, b++rest) | (tok, rest) <- lex s+                              , let (a:bs) = splitOn "." tok+                              , let b = intercalate "." ("":bs)]
+ src/Data/Scope.hs view
@@ -0,0 +1,37 @@+module Data.Scope+	( Scope(Scope)+	, lower+	, upper+	, contains+	, fromTuple+	, toTuple+	, everywhere+	) where++import Control.Arrow ( (&&&) )+import Data.Focus ( Focus, toList, unfocused )+import Data.List ( intercalate )++data Scope = Scope Focus Focus deriving (Eq, Ord)++instance Show Scope where+	show (Scope lo hi) = "(" ++ (str lo) ++ "-" ++ (str hi) ++ ")" where+		str = intercalate "." . map show . toList++lower :: Scope -> Focus+lower (Scope lo _) = lo++upper :: Scope -> Focus+upper (Scope _ hi) = hi++contains :: Scope -> Focus -> Bool+contains (Scope lo hi) f = f >= lo && f <= hi++fromTuple :: (Focus, Focus) -> Scope+fromTuple (lo, hi) = Scope lo hi++toTuple :: Scope -> (Focus, Focus)+toTuple = lower &&& upper++everywhere :: Scope+everywhere = Scope unfocused unfocused