pred-trie (empty) → 0.0.1
raw patch · 6 files changed
+170/−0 lines, 6 filesdep +QuickCheckdep +basedep +hspecsetup-changed
Dependencies added: QuickCheck, base, hspec, quickcheck-instances, semigroups
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- pred-trie.cabal +35/−0
- src/Data/Trie/Pred.hs +99/−0
- src/Data/Trie/Pred/Internal.hs +3/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Athan Clark++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 Athan Clark 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
+ pred-trie.cabal view
@@ -0,0 +1,35 @@+Name: pred-trie+Version: 0.0.1+Author: Athan Clark <athan.clark@gmail.com>+Maintainer: Athan Clark <athan.clark@gmail.com>+License: BSD3+License-File: LICENSE+Synopsis: Predicative tries+-- Description: +Cabal-Version: >= 1.10+Build-Type: Simple++Library+ Default-Language: Haskell2010+ HS-Source-Dirs: src+ GHC-Options: -Wall+ Exposed-Modules: Data.Trie.Pred+ Other-Modules: Data.Trie.Pred.Internal+ Build-Depends: base >= 4 && < 5+ , semigroups++Test-Suite spec+ Type: exitcode-stdio-1.0+ Default-Language: Haskell2010+ Hs-Source-Dirs: src+ , test+ Ghc-Options: -Wall+ Main-Is: Spec.hs+ Build-Depends: base+ , hspec+ , QuickCheck+ , quickcheck-instances++Source-Repository head+ Type: git+ Location: https://github.com/athanclark/pred-trie.git
+ src/Data/Trie/Pred.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE+ GADTs+ #-}++module Data.Trie.Pred+ ( PredTrie (..)+ , lookup+ , merge+ , areDisjoint+ ) where++import Data.Trie.Pred.Internal++import Prelude hiding (lookup)+import Data.List.NonEmpty hiding (map)+import Data.List.NonEmpty as NE hiding (map)+++-- | A predicative trie is composed of explicit predicate labels (for equality+-- tests of predicates), a type for node labels, and some content type+data PredTrie p t x where+ Rest :: NonEmpty t+ -> x+ -> PredTrie p t x+ More :: t+ -> Maybe x+ -> NonEmpty (PredTrie p t x)+ -> PredTrie p t x+ Pred :: p+ -> (t -> Maybe r)+ -> Maybe (r -> x)+ -> [PredTrie p t (r -> x)]+ -> PredTrie p t x+++-- | Overwrites when similar, leaves untouched when not+merge :: (Eq t, Eq p) => PredTrie p t x -> PredTrie p t x -> PredTrie p t x+merge xx@(Rest tss@(t:|ts) x) yy@(Rest pss@(p:|ps) y)+ | tss == pss = yy+ | t == p = let+ xx' = Rest (NE.fromList ts) x+ yy' = Rest (NE.fromList ps) y+ in+ More p Nothing $+ if areDisjoint xx' yy'+ then NE.fromList [xx', yy']+ else NE.fromList+ [merge (Rest (NE.fromList ts) x) (Rest (NE.fromList ps) y)]+ | otherwise = xx+merge xx@(More t mx xs) yy@(More p my ys)+ | t == p = More p my $ NE.fromList $ foldr go [] $ (NE.toList xs) ++ (NE.toList ys)+ | otherwise = xx+ where+ go :: (Eq t, Eq p) => PredTrie p t x -> [PredTrie p t x] -> [PredTrie p t x]+ go a [] = [a]+ go a (b:bs) | areDisjoint a b = a : b : bs+ | otherwise = (merge a b) : bs+merge xx@(Pred t q mrx xrs) yy@(Pred p w mry yrs)+ | t == p = yy+ | otherwise = xx+merge xx@(Rest (t:|ts) x) yy@(More p my ys)+ | t == p = case ts of+ [] -> More p (Just x) ys+ _ -> More p my $ fmap (merge $ Rest (NE.fromList ts) x) ys+ | otherwise = xx+merge xx@(More t mx xs) yy@(Rest (p:|ps) y)+ | t == p = case ps of+ [] -> More t (Just y) xs+ _ -> More t mx $ fmap (flip merge $ Rest (NE.fromList ps) y) xs+ | otherwise = yy+merge xx yy@(Pred _ _ _ _) = yy -- Predicates are more general+merge xx@(Pred _ _ _ _) yy = xx+++areDisjoint :: (Eq t, Eq p) => PredTrie p t x -> PredTrie p t x -> Bool+areDisjoint (Rest (t:|_) _) (Rest (p:|_) _) = t == p+areDisjoint (More t _ _) (More p _ _) = t == p+areDisjoint (Pred t _ _ _) (Pred p _ _ _) = t == p+++lookup :: Eq t => NonEmpty t -> PredTrie p t x -> Maybe x+lookup tss@(t:|ts) (Rest ps x) | tss == ps = Just x+ | otherwise = Nothing+lookup (t:|ts) (More t' mx xs) | t == t' =+ case ts of+ [] -> mx+ _ -> getFirst $ NE.toList $ fmap (lookup $ NE.fromList ts) xs+ | otherwise = Nothing+lookup (t:|ts) (Pred _ p mrx xrs) =+ p t >>=+ \r -> case ts of+ [] -> ($ r) <$> mrx+ _ -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)+++getFirst :: [Maybe a] -> Maybe a+getFirst [] = Nothing+getFirst (Nothing:xs) = getFirst xs+getFirst (Just x :xs) = Just x
+ src/Data/Trie/Pred/Internal.hs view
@@ -0,0 +1,3 @@+module Data.Trie.Pred.Internal+ (+ ) where
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}