git.iko.soy/schematic
on ae6719f help sign in
schematic/src/Data/Schematic/Path.hs
40 lines 1.4 kB history raw
1module Data.Schematic.Path where
3import Data.Foldable as F
4import Data.Monoid
5import Data.Singletons.Prelude
6import Data.Singletons.TypeLits
7import Data.Text as T
10data PathSegment = Key Symbol | Ix Nat
12data instance Sing (jp :: PathSegment) where
13 SKey :: (SingI k) => Sing (k :: Symbol) -> Sing ('Key k)
14 SIx :: (SingI n) => Sing (n :: Nat) -> Sing ('Ix n)
16data DemotedPathSegment = DKey Text | DIx Integer
17 deriving (Show)
19-- | Textual representation of json path.
20newtype JSONPath = JSONPath Text
21 deriving (Show)
23demotePath :: Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
24demotePath = go []
25 where
26 go :: [DemotedPathSegment] -> Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
27 go acc SNil = acc
28 go acc (SCons p ps) = go (acc ++ [demotePathSeg p]) ps
29 demotePathSeg :: Sing (ps :: PathSegment) -> DemotedPathSegment
30 demotePathSeg (SKey s) = DKey $ T.pack $ withKnownSymbol s $ symbolVal s
31 demotePathSeg (SIx n) = DIx $ withKnownNat n $ fromIntegral $ natVal n
33demotedPathToText :: [DemotedPathSegment] -> JSONPath
34demotedPathToText = JSONPath . F.foldl' renderPathSegment ""
35 where
36 renderPathSegment acc (DKey t) = acc <> "." <> t
37 renderPathSegment acc (DIx n) = acc <> "[" <> T.pack (show n) <> "]"
39pathToText :: Sing (ps :: [PathSegment]) -> JSONPath
40pathToText = demotedPathToText . demotePath