init

7 files changed, 400 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..48a004c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..d507eeb
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for accessor-hs
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..a3e26b7
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2025 Mistivia
+
+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/Readme.md b/Readme.md
new file mode 100644
index 0000000..c3b408c
--- /dev/null
+++ b/Readme.md
@@ -0,0 +1,79 @@
+# Accessor
+
+After trying very hard, I have to admit that my mind is too weak to understand lens. So I decided to roll my own data access library with no fancy categories but only getters, setters and fmaps chained together. 
+
+To get started:
+
+    import Accessor
+
+An accessors is a getter with a setter.
+
+For record fields, the accessors are defined as follow:
+
+    data Point = Point {_x :: Int, _y :: Int}
+    
+    x = accessor _x (\elem record -> record {x = elem})
+    y = accessor _y (\elem record -> record {y = elem})
+
+With an accessor, you can view, set, and tranform data of the record:
+
+    point = Point 1 2
+    view x point -- 1
+    set x 3 point -- Point 3 2
+    over x (+1) point -- Point 2 2
+
+For a nested record, accessors can be composed usine `(#)`:
+
+    data Line = Line {_start :: Point, _end :: Point}
+    start = accessor _start (\elem record -> record {_start = elem})
+    end = accessor _end (\elem record -> record {_end = elem})
+    
+
+    data Point = Point {_x :: Int, _y :: Int}
+    x = accessor _x (\elem record -> record {_x = elem})
+    y = accessor _y (\elem record -> record {_y = elem})
+
+    line = Line (Point 1 2) (Point 3 4)
+
+    start_x = view (start # x) line -- 1
+    end_y = view (start # y) line -- 4
+
+If the field is a functor, the accessor should be composed with the next accesor using `(#>)`. For exmaple:
+
+    data Person = Person {_name :: String, _addr = Maybe Address }
+    name = accessor _name (\elem record -> record {_name = elem}) 
+    addr= accessor _addr (\elem record -> record {_addr = elem}) 
+
+    data Address = Address {_detail :: String, _code :: String }
+    detail = accessor _detail (\elem record -> record {_detail = elem}) 
+    code = accessor _code (\elem record -> record {_code = elem}) 
+
+Let there be Alice living in Shanghai:
+
+    alice = Person
+      { _name = "Alice"
+      , _addr = Just Address
+        { _detail = "Shanghai"
+        , _code = "200000"
+        }
+      }
+
+You can view/modify Alice's address detail:
+
+    s = view (addr #> detail) alice -- Just "Shanghai"
+
+`fmap` will make sure `Nothing` be handled properly.
+
+Aceesor of the nth element of a list is `listAt n`, and for 0~9, there are shortcuts `_0`~`_9`.
+
+    view _1 [1,2,3] -- 2
+    view (_1 # _1) [[1,2,3], [4,5,6]] -- 5
+    set _0 42 [1,2,3] -- [42,2,3]
+    over _1 (+1) [1,2,3] -- [1,3,3]
+
+Lists are also functors, so you can `fmap` over it using `(#>)`, which is the same as `map`:
+
+    over (self #> self) (+1) [1,2,3] -- [2,3,4]
+    over (_1 #> self) (+1) [[1,2], [2,3]] -- [[1,2],[4,5]]
+
+
diff --git a/accessor-hs.cabal b/accessor-hs.cabal
new file mode 100644
index 0000000..f5160b8
--- /dev/null
+++ b/accessor-hs.cabal
@@ -0,0 +1,76 @@
+cabal-version:      3.0
+-- The cabal-version field refers to the version of the .cabal specification,
+-- and can be different from the cabal-install (the tool) version and the
+-- Cabal (the library) version you are using. As such, the Cabal (the library)
+-- version used must be equal or greater than the version stated in this field.
+-- Starting from the specification version 2.2, the cabal-version field must be
+-- the first thing in the cabal file.
+
+-- Initial package description 'accessor-hs' generated by
+-- 'cabal init'. For further documentation, see:
+--   http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name:               accessor-hs
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:            MIT
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+-- The package author(s).
+author:             Mistivia
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer:         i@mistivia.com
+
+-- A copyright notice.
+-- copyright:
+category:           Data
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+
+-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall -dynamic
+
+library
+    import:           warnings
+
+    exposed-modules:  Accessor
+    build-depends:    base ^>=4.17.2.1
+
+    hs-source-dirs:   src
+
+    default-language: GHC2021
+
+test-suite accessor-hs-test
+    import:           warnings
+    type: exitcode-stdio-1.0
+    main-is: AccessorTest.hs
+    default-language: GHC2021
+    hs-source-dirs:   test
+    build-depends:
+        base ^>=4.17.2.1,
+        HUnit,
+        accessor-hs
diff --git a/src/Accessor.hs b/src/Accessor.hs
new file mode 100644
index 0000000..a1623fc
--- /dev/null
+++ b/src/Accessor.hs
@@ -0,0 +1,94 @@
+module Accessor
+    ( accessor
+    , Accessor
+    , view
+    , over
+    , set
+    , (#)
+    , (#>)
+    , listAcc
+    , fstAcc
+    , sndAcc
+    , self
+    , _0, _1, _2, _3, _4
+    , _5, _6, _7, _8, _9
+    )
+where
+
+type Accessor s a r = (a -> a) -> s -> (s, r)
+
+accessor :: (s -> a) -> (a -> s -> s) -> Accessor s a a
+accessor getter setter f x = (setter newVal x, getter x) where
+  newVal = f (getter x)
+
+view :: Accessor s a b -> s -> b
+view acc = snd . acc id
+
+over :: Accessor s a b -> (a -> a) -> s -> s
+over acc f = fst . acc f
+
+set :: Accessor s a b ->  a -> s -> s
+set acc x = over acc (const x)
+
+infixr #
+
+(#) ::
+    Accessor obj middle middle -> Accessor middle end end -> Accessor obj end end
+(#) = composeAccessors where
+  composeAccessors ac1 ac2 modifier obj =
+    (newObj, value)
+    where
+      newObj = over ac1 (over ac2 modifier) obj
+      value = view ac2 (view ac1 obj)
+
+infixr #>
+
+(#>) :: (Functor f) =>
+    Accessor obj (f middle) (f middle) -> Accessor middle end result
+    -> Accessor obj end (f result)
+(#>) = composeFunctorAccesors where
+  composeFunctorAccesors ac1 ac2 modifier obj =
+    (newObj, value)
+    where
+      newObj = over ac1 (fmap $ over ac2 modifier) obj
+      value = fmap (view ac2) (view ac1 obj)
+
+self :: Accessor a a a
+self = accessor id const 
+
+listAcc :: Int -> Accessor [a] a a
+listAcc idx = accessor getter setter where
+    getter = (!! max 0 idx)
+    setter n lst = take idx lst ++ [n] ++ drop (idx + 1) lst
+
+_0 :: Accessor [a] a a
+_1 :: Accessor [a] a a
+_2 :: Accessor [a] a a
+_3 :: Accessor [a] a a
+_4 :: Accessor [a] a a
+_5 :: Accessor [a] a a
+_6 :: Accessor [a] a a
+_7 :: Accessor [a] a a
+_8 :: Accessor [a] a a
+_9 :: Accessor [a] a a
+
+_0 = listAcc 0
+_1 = listAcc 1
+_2 = listAcc 2
+_3 = listAcc 3
+_4 = listAcc 4
+_5 = listAcc 5
+_6 = listAcc 6
+_7 = listAcc 7
+_8 = listAcc 8
+_9 = listAcc 9
+
+fstAcc :: Accessor (a, b) a a
+fstAcc = accessor getter setter where
+    getter (a, _) = a
+    setter n x = (n, snd x)
+
+sndAcc :: Accessor (a, b) b b
+sndAcc = accessor getter setter where
+    getter (_, b) = b
+    setter n x = (fst x, n)
diff --git a/test/AccessorTest.hs b/test/AccessorTest.hs
new file mode 100644
index 0000000..861a7a4
--- /dev/null
+++ b/test/AccessorTest.hs
@@ -0,0 +1,125 @@
+module Main where
+
+import Accessor
+import Test.HUnit
+import System.Exit
+
+testListSet_1 :: Test
+testListSet_1 = TestCase (assertEqual "list set 1" expect result) where
+  result =
+    let lst = [1,2,3] :: [Int]
+    in set _0 42 lst
+  expect = [42,2,3]
+      
+testListSet_2 :: Test
+testListSet_2 = TestCase (assertEqual "list set 2" expect result) where
+  result =
+    let lst = [[1,2,3],[4,5,6],[7,8,9]] :: [[Int]]
+    in set (_1 # _1) 42 lst
+  expect = [[1,2,3],[4,42,6],[7,8,9]]
+
+testListSet_3 :: Test
+testListSet_3 = TestCase (assertEqual "list set 3" expect result) where
+  result =
+    let lst = [[1,2,3],[4,5,6],[7,8,9]] :: [[Int]]
+    in over (_1 #> self) (+1) lst
+  expect = [[1,2,3],[5,6,7],[7,8,9]]
+
+testTuple_1 :: Test
+testTuple_1 = TestCase (assertEqual "tuple 1" expect result) where
+  result  = view (self #> sndAcc) $ Just (1 :: Int, 42 :: Int)
+  expect = Just 42
+
+testTuple_2 :: Test
+testTuple_2 = TestCase (assertEqual "tuple 2" expect result) where
+  result = view (self #> _1 # _2 # _3) Nothing :: Maybe Int
+  expect = Nothing
+
+data Person = Person
+  { _name :: String,
+    _address :: Maybe Address
+  }
+  deriving (Show)
+name :: Accessor Person String String
+name = accessor _name (\n x -> x {_name = n})
+address :: Accessor Person (Maybe Address) (Maybe Address)
+address = accessor _address (\n x -> x {_address = n})
+
+data Address = Address
+  { _city :: String,
+    _zipInfos :: [Maybe ZipInfo]
+  }
+  deriving (Show)
+city :: Accessor Address String String
+city = accessor _city (\n x -> x {_city = n})
+zipInfos :: Accessor Address [Maybe ZipInfo] [Maybe ZipInfo]
+zipInfos = accessor _zipInfos (\n x -> x {_zipInfos = n})
+
+data ZipInfo = ZipInfo
+  { _code :: String,
+    _extraInfo :: Maybe String
+  }
+  deriving (Show)
+code :: Accessor ZipInfo String String
+code = accessor _code (\n x -> x {_code = n})
+extraInfo :: Accessor ZipInfo (Maybe String) (Maybe String)
+extraInfo = accessor _extraInfo (\n x -> x {_extraInfo = n})
+
+recordTests :: [Test]
+recordTests = 
+  let
+    alice = Person
+     { _name = "Alice"
+     , _address = Just Address
+       { _city = "Shanghai"
+       , _zipInfos =
+         [ Just ZipInfo
+             { _code = "200000"
+             , _extraInfo = Nothing
+             },
+           Just ZipInfo
+             { _code = "200002"
+             , _extraInfo = Nothing
+             }
+         ]
+       }
+     }
+  in
+    [ let 
+        tname = "record view"
+        result = view name alice
+        expect = "Alice"
+      in TestCase (assertEqual tname result expect)
+    , let 
+        tname = "record fmap view"
+        result = view (address #> city) alice
+        expect = Just "Shanghai"
+      in TestCase (assertEqual tname result expect)
+    , let
+        tname = "record multiple fmap view"
+        result = view (address #> zipInfos #> self #> code) alice
+        expect = Just [Just "200000", Just "200002"]
+      in TestCase (assertEqual tname expect result)
+    , let
+        tname = "record multiple fmap edit"
+        newAlice =  over (address #> zipInfos #> self #> code) (++ "uwu") alice
+        result = view (address #> zipInfos #> self #> code) newAlice
+        expect = Just [Just "200000uwu", Just "200002uwu"]
+      in TestCase (assertEqual tname expect result)
+    ]
+
+main :: IO ()
+main = do
+  let mytests = TestList $ 
+        [ testListSet_1
+        ,  testListSet_2
+        , testListSet_3
+        , testTuple_1
+        , testTuple_2
+        ]
+         ++ recordTests
+  results <- runTestTT mytests
+  if errors results + failures results == 0 then
+      exitSuccess
+  else
+      exitWith (ExitFailure 1)