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