git.iko.soy/schematic
on 1ea9e01 help sign in
schematic/src/Data/Schematic/Path.hs
50 lines 1.6 kB history raw
1module Data.Schematic.Path where
3import Data.Foldable as F
4import Data.Monoid
5import Data.Schematic.Utils
6import Data.Singletons
7import Data.Singletons.Prelude
8import Data.Singletons.TypeLits
9import Data.Text as T
12data PathSegment = Key Symbol | Ix Nat
14data instance Sing (jp :: PathSegment) where
15 SKey :: (KnownSymbol k, Known (Sing k)) => Sing (k :: Symbol) -> Sing ('Key k)
16 SIx :: (KnownNat n, Known (Sing n)) => Sing (n :: Nat) -> Sing ('Ix n)
18instance (KnownSymbol k, Known (Sing k))
19 => Known (Sing ('Key k)) where
20 known = SKey known
22instance (KnownNat n, Known (Sing n))
23 => Known (Sing ('Ix n)) where
24 known = SIx known
26data DemotedPathSegment = DKey Text | DIx Integer
27 deriving (Show)
29-- | Textual representation of json path.
30newtype JSONPath = JSONPath Text
31 deriving (Show)
33demotePath :: Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
34demotePath = go []
35 where
36 go :: [DemotedPathSegment] -> Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
37 go acc SNil = acc
38 go acc (SCons p ps) = go (acc ++ [demote p]) ps
39 demote :: Sing (ps :: PathSegment) -> DemotedPathSegment
40 demote (SKey s) = DKey $ T.pack $ symbolVal s
41 demote (SIx n) = DIx $ natVal n
43demotedPathToText :: [DemotedPathSegment] -> JSONPath
44demotedPathToText = JSONPath . F.foldl' renderPathSegment ""
45 where
46 renderPathSegment acc (DKey t) = acc <> "." <> t
47 renderPathSegment acc (DIx n) = acc <> "[" <> T.pack (show n) <> "]"
49pathToText :: Sing (ps :: [PathSegment]) -> JSONPath
50pathToText = demotedPathToText . demotePath