git.iko.soy/typeable/schematic
on eabb823 help sign in
typeable/schematic/src/Data/Schematic/Path.hs
36 lines 1.2 kB history raw
1module Data.Schematic.Path where
3import Data.Foldable as F
4import Data.Singletons.Prelude
5import Data.Singletons.TypeLits
6import Data.Text as T
7import Data.Aeson.Internal
10newtype JSONPathText = JSONPathText Text
11 deriving (Show)
13data PathSegment = PathKey Symbol | PathIx Nat
15data instance Sing (jp :: PathSegment) where
16 SKey :: (SingI k) => Sing (k :: Symbol) -> Sing ('PathKey k)
17 SIx :: (SingI n) => Sing (n :: Nat) -> Sing ('PathIx n)
19demotePath :: Sing (ps :: [PathSegment]) -> JSONPath
20demotePath = go []
21 where
22 go :: JSONPath -> Sing (ps :: [PathSegment]) -> JSONPath
23 go acc SNil = acc
24 go acc (SCons p ps) = go (acc ++ [demotePathSeg p]) ps
25 demotePathSeg :: Sing (ps :: PathSegment) -> JSONPathElement
26 demotePathSeg (SKey s) = Key $ T.pack $ withKnownSymbol s $ symbolVal s
27 demotePathSeg (SIx n) = Index $ withKnownNat n $ fromIntegral $ natVal n
29demotedPathToText :: JSONPath -> JSONPathText
30demotedPathToText = JSONPathText . F.foldl' renderPathSegment ""
31 where
32 renderPathSegment acc (Key t) = acc <> "." <> t
33 renderPathSegment acc (Index n) = acc <> "[" <> T.pack (show n) <> "]"
35pathToText :: Sing (ps :: [PathSegment]) -> JSONPathText
36pathToText = demotedPathToText . demotePath