From 74bb17eee301aa6a97b60e3bcd9d57e461c16713 Mon Sep 17 00:00:00 2001
From: Austin Erlandson <austinerlandson77@gmail.com>
Date: Sat, 26 Nov 2022 17:17:46 -0600
Subject: [PATCH] WIP: Tryin' to work out elm-json-accessors :grimacing:

---
 elm.json               |   2 +
 src/Base.elm           |   2 +-
 src/Json/Accessors.elm | 135 ++++++++++++++++++++++++++++++++++++++++-
 tests/Laws.elm         |   4 +-
 4 files changed, 137 insertions(+), 6 deletions(-)

diff --git a/elm.json b/elm.json
index dc234e9..2a1ae3a 100644
--- a/elm.json
+++ b/elm.json
@@ -17,7 +17,9 @@
     ],
     "elm-version": "0.19.0 <= v < 0.20.0",
     "dependencies": {
+        "andre-dietrich/elm-generic": "2.0.0 <= v < 3.0.0",
         "elm/core": "1.0.0 <= v < 2.0.0",
+        "elm/json": "1.0.0 <= v < 2.0.0",
         "lue-bird/elm-rosetree-path": "1.1.0 <= v < 2.0.0",
         "miyamoen/select-list": "4.1.0 <= v < 5.0.0",
         "zwilias/elm-rosetree": "1.5.0 <= v < 2.0.0"
diff --git a/src/Base.elm b/src/Base.elm
index 7a2403b..1f984fa 100644
--- a/src/Base.elm
+++ b/src/Base.elm
@@ -181,7 +181,7 @@ prism n bt sta sub =
         { view = void "Can't call `view` with a Prism"
         , list =
             sta
-                >> Result.map (\a -> [ a ])
+                >> Result.map List.singleton
                 >> Result.withDefault []
         , make = bt
         , over = over_
diff --git a/src/Json/Accessors.elm b/src/Json/Accessors.elm
index 66367e6..4c06c21 100644
--- a/src/Json/Accessors.elm
+++ b/src/Json/Accessors.elm
@@ -1,5 +1,134 @@
-module Json.Accessors exposing (..)
+module Json.Accessors exposing
+    ( at
+    , bool_
+    , float_
+    , int_
+    , key
+    , list_
+    , null_
+    , object_
+    , string_
+    , value_
+    )
 
+import Base exposing (..)
+import Dict exposing (Dict)
+import Dict.Accessors as Dict
+import Generic
+import Generic.Json as Json
+import Json.Encode as Encode
+import List.Accessors as List
 
-stubb =
-    Debug.todo "make jq expressions from Lenses?"
+
+value_ : Optic pr ls Generic.Value Generic.Value x y -> Prism pr String String x y
+value_ =
+    prism "JSON"
+        (Json.encode >> Encode.encode 0)
+        (\v -> Json.decode v |> Result.mapError (\_ -> v))
+
+
+int_ : Optic pr ls Int Int x y -> Prism pr String String x y
+int_ =
+    value_
+        << prism "int"
+            Generic.Int
+            (Generic.toInt
+                >> Maybe.map Ok
+                >> Maybe.withDefault (Err Generic.Null)
+            )
+
+
+float_ : Optic pr ls Float Float x y -> Prism pr String String x y
+float_ =
+    value_
+        << prism "float"
+            Generic.Float
+            (Generic.toFloat
+                >> Maybe.map Ok
+                >> Maybe.withDefault (Err Generic.Null)
+            )
+
+
+string_ : Optic pr ls String String x y -> Prism pr String String x y
+string_ =
+    value_
+        << prism "string"
+            Generic.String
+            (\v ->
+                case v of
+                    Generic.String s ->
+                        Ok s
+
+                    _ ->
+                        Err v
+            )
+
+
+bool_ : Optic pr ls Bool Bool x y -> Prism pr String String x y
+bool_ =
+    value_
+        << prism "bool"
+            Generic.Bool
+            (\v ->
+                case v of
+                    Generic.Bool b ->
+                        Ok b
+
+                    _ ->
+                        Err v
+            )
+
+
+null_ : Optic pr ls () b x y -> Prism pr String String x y
+null_ =
+    value_
+        << prism "null"
+            (always Generic.Null)
+            (\v ->
+                case v of
+                    Generic.Null ->
+                        Ok ()
+
+                    _ ->
+                        Err v
+            )
+
+
+list_ : Optic pr ls (List Generic.Value) (List Generic.Value) x y -> Prism pr String String x y
+list_ =
+    value_
+        << prism "List"
+            Generic.List
+            (\v ->
+                case v of
+                    Generic.List a ->
+                        Ok a
+
+                    _ ->
+                        Err v
+            )
+
+
+object_ : Optic pr ls (Dict String Generic.Value) (Dict String Generic.Value) x y -> Prism pr String String x y
+object_ =
+    value_
+        << prism "Dict"
+            (Dict.toList >> (List.map << Tuple.mapFirst) Generic.String >> Generic.dictFromList)
+            (\v ->
+                case Generic.toDict v of
+                    Just o ->
+                        Ok o
+
+                    Nothing ->
+                        Err v
+            )
+
+
+key : String -> Optic pr ls (Maybe Generic.Value) (Maybe Generic.Value) x y -> Traversal String String x y
+key s =
+    object_ << Dict.at s
+
+
+at : Int -> Optic pr ls Generic.Value Generic.Value x y -> Traversal String String x y
+at i =
+    list_ << List.at i
diff --git a/tests/Laws.elm b/tests/Laws.elm
index 833d67d..4ff576b 100644
--- a/tests/Laws.elm
+++ b/tests/Laws.elm
@@ -253,8 +253,8 @@ iso_yon l a =
 
 
 
--- traverse_pure : LensLike' f s a -> s -> Bool
--- traverse_pure l s = l pure s == (pure s : f s)
+-- traverse_pure : Applicative f => LensLike' f s a -> s -> Bool
+-- traverse_pure l s = l pure s == (pure s :: f s) -- :: is an inline type annotation
 -- traverse_pureMaybe : Eq s => LensLike' Maybe s a -> s -> Bool
 -- traverse_pureMaybe = traverse_pure
 -- traverse_pureList : Eq s => LensLike' [] s a -> s -> Bool