rg (empty) → 1.2.0.0

raw patch · 7 files changed

+329/−0 lines, 7 filesdep +arraydep +basedep +fmtsetup-changed

Dependencies added: array, base, fmt, possibly, rg, tasty, tasty-hunit, text, unordered-containers, vector

Files

ChangeLog.md +7/−0
LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
rg.cabal +67/−0
src/Data/Rg.hs +162/−0
test/test.hs +58/−0

+ ChangeLog.md view

@@ -0,0 +1,7 @@+# Changelog for rg++## Unreleased changes++  * 1.0.0.0: first release+  * 1.1.0.0: add RgText, BE derivation+  - 1.2.0.0: first public release

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Chris Dornan (c) 2019++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 Chris Dornan 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.

+ README.md view

@@ -0,0 +1,3 @@+# rg++A package for dynamic/unbounded Haskell enumerations.

+ Setup.hs view

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

+ rg.cabal view

@@ -0,0 +1,67 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 527175fcfe23d40d0a87e869a4613c10ea692ae5c67e26c181bae7d7f71687ee++name:           rg+version:        1.2.0.0+synopsis:       A dynamic/unbounded alternative to Bounded Enum+description:    Please see the README on GitHub at <https://github.com/cdornan/rg#readme>+category:       Types+homepage:       https://github.com/cdornan/rg#readme+bug-reports:    https://github.com/cdornan/rg/issues+author:         Chris Dornan+maintainer:     chris.dornan@irisconnect.co.uk+copyright:      2019 Chris Dornan+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/cdornan/rg++library+  exposed-modules:+      Data.Rg+  other-modules:+      Paths_rg+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat+  build-depends:+      array+    , base >=4.10 && <5+    , fmt >=0.4.0.0+    , possibly+    , text+    , unordered-containers+    , vector+  default-language: Haskell2010++test-suite nike-test+  type: exitcode-stdio-1.0+  main-is: test.hs+  other-modules:+      Paths_rg+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -with-rtsopts "-T -N -qg -qb -H1024m -I0" -threaded -rtsopts+  build-depends:+      array+    , base >=4.10 && <5+    , fmt >=0.4.0.0+    , possibly+    , rg+    , tasty+    , tasty-hunit+    , text+    , unordered-containers+    , vector+  default-language: Haskell2010

+ src/Data/Rg.hs view

@@ -0,0 +1,162 @@+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Rg+  ( Rg(..)+  , RgText(..)+  , BE(..)+  , Range+  , newStartOfRangeFromList+  , newStartOfRangeFromVector+  , extractRange+  ) where++import           Data.Array+import qualified Data.HashMap.Strict  as HM+import           Data.Maybe+import           Data.Possibly+import qualified Data.Text            as T+import qualified Data.Vector          as V+import           Fmt+++-- | Rg acts a bit like a Bounded Enum, but the size of the enumeration+-- can be dynamically determined from each value in the type (see 'sizeRg')+class Rg rg where+  -- | the number of values in the enumeration; sizeRg sz > 0+  sizeRg      :: rg -> Int++  -- | the nth item in the enumeration (first is 0)+  toRg        :: rg -> Int -> Maybe rg++  -- | place in the enumation (first is 0)+  fromRg      :: rg -> Int++  -- | first item in the enumeration+  minRg       :: rg -> rg+  minRg    = fromMaybe oops . flip toRg 0+    where+      oops = error "minRg: no minimum value in range"++  -- | last item in the enumeration+  maxRg       :: rg -> rg+  maxRg rg = fromMaybe oops $ toRg rg n+    where+      n    = sizeRg rg - 1+      oops = error "maxRg: no maximum value in range"++  -- | next item in the enumeration (Nothing if already last)+  succRg      :: rg -> Maybe rg+  succRg rg = toRg rg $ fromRg rg + 1++  -- | previous item in the enumeration (Nothing if already first)+  predRg      :: rg -> Maybe rg+  predRg rg = toRg rg $ fromRg rg - 1++  -- | list given items in the enumeration+  allListRg   :: rg -> [rg]+  allListRg rg = listRg rg [0..]++  -- | list given items in the enumeration, stopping as soon as an index is+  -- out of range+  listRg      :: rg -> [Int] -> [rg]+  listRg rg is = catMaybes $ takeWhile isJust [ toRg rg i | i<-is ]++  -- | list given items in the enumeration as a 'V.Vector'+  allVectorRg :: rg -> [rg]+  allVectorRg rg = listRg rg [0..]++  -- | list the items in the enumeration as a 'V.Vector', stopping as soon as an+  -- index is out of range+  vectorRg    :: rg -> [Int] -> V.Vector rg+  vectorRg rg is = V.fromList $ listRg rg is+++-------------------------------------------------------------------------------+-- class RgText+-------------------------------------------------------------------------------++-- | a class in which we can build things and parse them from 'T.Text'+class (Rg e, Buildable e, Eq e, Ord e, Show e) => RgText e where+  parseRgText :: e -> T.Text -> Possibly e+  parseRgText e txt = maybe (Left msg) Right $ HM.lookup txt $ hashmap_t e+    where+      msg = "parseRgText: enumeration not recognised: "++show txt+++-------------------------------------------------------------------------------+-- newtype BE+-------------------------------------------------------------------------------++-- | a @newtype@ wrapper used for deriving 'Rg' instances from 'Bounded' 'Enum'+newtype BE a = BE { _BE :: a }+  deriving  (Eq,Ord,Bounded,Enum,Show)++instance (Bounded i,Enum i) => Rg (BE i) where+  sizeRg be = (1 +) $ fromEnum $ maxBound `asTypeOf` _BE be++  toRg be i = case 0 <= i && i < sizeRg be of+    True  -> Just $ BE $ toEnum i+    False -> Nothing++  fromRg = fromEnum . _BE+++-------------------------------------------------------------------------------+-- data Range+-------------------------------------------------------------------------------++-- | used to generate 'Rg' values from lists of things+data Range a =+  Range+    { _rg_size  :: Int          -- ^ number of items in enumeration (derivable from Array)+    , _rg_elem  :: Int          -- ^ position in the enumeration of this element+    , _rg_array :: Array Int a  -- ^ all of the elements of the enumeration+    }+  deriving (Show)++instance Rg (Range a) where+  sizeRg      = _rg_size+  toRg   rg i = case 0 <= i && i < _rg_size rg of+    False -> Nothing+    True  -> Just rg { _rg_elem = i }+  fromRg      = _rg_elem++-- | generating a 'Range' from a list+newStartOfRangeFromList :: [a] -> Range a+newStartOfRangeFromList xs =+  Range+    { _rg_size  = sz+    , _rg_elem  = 0+    , _rg_array = listArray (0,sz-1) xs+    }+  where+    sz = length xs++-- | generating a 'Range' from a 'V.Vector'+newStartOfRangeFromVector :: V.Vector a -> Range a+newStartOfRangeFromVector v =+  Range+    { _rg_size  = sz+    , _rg_elem  = 0+    , _rg_array = listArray (0,sz-1) $ V.toList v+    }+  where+    sz = V.length v++-- | extracting the thing+extractRange :: Range a -> a+extractRange Range{..} = _rg_array ! _rg_elem+++-------------------------------------------------------------------------------+-- hashmap_t+-------------------------------------------------------------------------------++-- | 'T.Text' 'HM.HashMap' based on 'renderEnumText' representation+hashmap_t :: RgText e => e -> HM.HashMap T.Text e+hashmap_t x = HM.fromList+    [ (fmt $ build c,c)+      | c <- allListRg x+      ]

+ test/test.hs view

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# OPTIONS_GHC -fno-warn-orphans       #-}++module Main (main) where++import           Data.Rg+import           Fmt+import           Test.Tasty+import           Test.Tasty.HUnit+++main :: IO ()+main = defaultMain $+    testGroup "rg" $+    [ testGroup "Range"+      [ testCase "sizeRg"         $ 10        @=? sizeRg tst+      , testCase "allListRg"      $ [10,9..1] @=? map extractRange (allListRg tst)+      , testCase "predRg"         $ Nothing   @=? (extractRange <$> predRg tst)+      , testCase "predRg . maxRg" $ Just 2    @=? (extractRange <$> predRg (maxRg tst))+      , testCase "succRg"         $ Just 9    @=? (extractRange <$> succRg tst)+      , testCase "extractRange"   $ 10        @=? extractRange tst+      , testCase "minRg"          $ 10        @=? extractRange (minRg tst)+      , testCase "maxRg"          $ 1         @=? extractRange (maxRg tst)+      , testCase "extractRange"   $ 1         @=? extractRange (maxRg tst)+      , testCase "fromRg"         $ 0         @=? fromRg tst+      , testCase "minRg"          $ 0         @=? fromRg (minRg tst)+      , testCase "maxRg"          $ 9         @=? fromRg (maxRg tst)+      , testCase "toRg"           $ Just 5    @=? (fromRg <$> toRg tst 5)+      ]+    , testGroup "BE"+      [ testCase "sizeRg True"    $ 2                  @=? sizeRg    (BE True )+      , testCase "sizeRg False"   $ 2                  @=? sizeRg    (BE False)+      , testCase "toRg 0"         $ Just (BE False)    @=? toRg      (BE False) 0+      , testCase "toRg 1"         $ Just (BE True )    @=? toRg      (BE False) 1+      , testCase "toRg 3"         $ Nothing            @=? toRg      (BE False) 2+      , testCase "allListRg"      $ [BE False,BE True] @=? allListRg (BE False)+      , testCase "fromRg False"   $ 0                  @=? fromRg    (BE False)+      , testCase "fromRg True"    $ 1                  @=? fromRg    (BE True )+      ]+    , testGroup "RgText"+      [ testCase "TRUE"    $ Right (BE True ) @=? parseRgText (BE False) "TRUE"+      , testCase "FALSE"   $ Right (BE False) @=? parseRgText (BE True ) "FALSE"+      , testCase "true"    $ Left msg         @=? parseRgText (BE False) "false"+      ]+    ]+  where+    tst :: Range Int+    tst = newStartOfRangeFromList [10,9..1]++    msg :: String+    msg = "parseRgText: enumeration not recognised: \"false\""++instance RgText (BE Bool)++instance Buildable (BE Bool) where+  build (BE True)  = "TRUE"+  build (BE False) = "FALSE"