Initial commit: some small builder functions and scaffolding but no implementations yet of algorithms
Getty Ritter
8 years ago
1 | {-# LANGUAGE OverloadedStrings #-} | |
2 | {-# LANGUAGE RecordWildCards #-} | |
3 | ||
4 | module Data.Aeson.Linked.Builder where | |
5 | ||
6 | import Data.Aeson | |
7 | import Data.Text (Text) | |
8 | import qualified Data.Text as T | |
9 | import Data.Vector (fromList) | |
10 | ||
11 | data LDField = LDField | |
12 | { fiName :: Text | |
13 | , fiIRI :: Text | |
14 | , fiType :: Maybe Text | |
15 | } deriving (Eq, Show) | |
16 | ||
17 | unlinkedObject :: [(LDField, Value)] -> Value | |
18 | unlinkedObject is = | |
19 | object [ (name, value) | (LDField { fiName = name }, value) <- is ] | |
20 | ||
21 | -- | Create a compact JSON-LD document with the provided key-value pairs. | |
22 | ldObject :: [(LDField, Value)] -> Value | |
23 | ldObject is = object ( ("@context", ldContext (map fst is)) : fs ) | |
24 | where fs = [ (fiName info, value) | (info, value) <- is ] | |
25 | ||
26 | ldObjectExpanded :: [(LDField, Value)] -> Value | |
27 | ldObjectExpanded is = | |
28 | object [ ( fiIRI | |
29 | , Array $ fromList | |
30 | [ case fiType of | |
31 | Just typ -> object [ (typ, val) ] | |
32 | Nothing -> object [ ("@value", val) ] | |
33 | ] | |
34 | ) | |
35 | | (LDField { .. }, val) <- is | |
36 | ] | |
37 | ||
38 | ldContext :: [LDField] -> Value | |
39 | ldContext is = object [ (fiName info, mkCtx info) | info <- is ] | |
40 | where mkCtx LDField { .. } | |
41 | | Nothing <- fiType = String fiIRI | |
42 | | Just typ <- fiType = | |
43 | object [ ("@id", String fiIRI), ("@type", String typ) ] | |
44 | ||
45 | -- | Create a representation of a Linked Data field, which must contain | |
46 | -- both a name and an associated IRI. | |
47 | field :: Text -> Text -> LDField | |
48 | field fiName fiIRI = LDField fiName fiIRI Nothing | |
49 | ||
50 | -- | Set the "type" field of a context. | |
51 | withType :: LDField -> Text -> LDField | |
52 | withType f typ = f { fiType = Just typ } |
1 | {-# LANGUAGE RecordWildCards #-} | |
2 | ||
3 | module Data.Aeson.Linked where | |
4 | ||
5 | import Data.Aeson | |
6 | ||
7 | data CompactOpts = CompactOpts | |
8 | { coBase :: String | |
9 | , coCompactArrays :: Bool | |
10 | , coGraph :: Bool | |
11 | , coSkipExpension :: Bool | |
12 | , coActiveCtx :: Bool | |
13 | , coLink :: Bool | |
14 | } deriving (Eq, Show) | |
15 | ||
16 | defaultCompactOpts :: CompactOpts | |
17 | defaultCompactOpts = CompactOpts | |
18 | { coBase = "" | |
19 | , coCompactArrays = True | |
20 | , coGraph = False | |
21 | , coSkipExpension = False | |
22 | , coActiveCtx = False | |
23 | , coLink = False | |
24 | } | |
25 | ||
26 | compact :: Value -> Value -> Value | |
27 | compact = compactWithOpts defaultCompactOpts | |
28 | ||
29 | compactWithOpts :: CompactOpts -> Value -> Value -> Value | |
30 | compactWithOpts = undefined | |
31 | ||
32 | data ExpandOpts = ExpandOpts | |
33 | { eoKeepFreeFloatingNodes :: Bool | |
34 | } deriving (Eq, Show) | |
35 | ||
36 | defaultExpandOpts :: ExpandOpts | |
37 | defaultExpandOpts = ExpandOpts | |
38 | { eoKeepFreeFloatingNodes = False | |
39 | } | |
40 | ||
41 | expand :: Value -> Value | |
42 | expand = expandWithOpts defaultExpandOpts | |
43 | ||
44 | expandWithOpts :: ExpandOpts -> Value -> Value | |
45 | expandWithOpts ExpandOpts { .. } = undefined | |
46 | ||
47 | flatten :: Value -> Value | |
48 | flatten = undefined | |
49 | ||
50 | frame :: Value -> Value | |
51 | frame = undefined | |
52 | ||
53 | normalize :: Value -> Value | |
54 | normalize = undefined |
1 | Copyright (c) 2016, Getty Ritter | |
2 | ||
3 | All rights reserved. | |
4 | ||
5 | Redistribution and use in source and binary forms, with or without | |
6 | modification, are permitted provided that the following conditions are met: | |
7 | ||
8 | * Redistributions of source code must retain the above copyright | |
9 | notice, this list of conditions and the following disclaimer. | |
10 | ||
11 | * Redistributions in binary form must reproduce the above | |
12 | copyright notice, this list of conditions and the following | |
13 | disclaimer in the documentation and/or other materials provided | |
14 | with the distribution. | |
15 | ||
16 | * Neither the name of Getty Ritter nor the names of other | |
17 | contributors may be used to endorse or promote products derived | |
18 | from this software without specific prior written permission. | |
19 | ||
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
1 | -- Initial aeson-ld.cabal generated by cabal init. For further | |
2 | -- documentation, see http://haskell.org/cabal/users-guide/ | |
3 | ||
4 | name: aeson-ld | |
5 | version: 0.1.0.0 | |
6 | -- synopsis: | |
7 | -- description: | |
8 | license: BSD3 | |
9 | license-file: LICENSE | |
10 | author: Getty Ritter | |
11 | maintainer: gettylefou@gmail.com | |
12 | -- copyright: | |
13 | category: Data | |
14 | build-type: Simple | |
15 | extra-source-files: ChangeLog.md | |
16 | cabal-version: >=1.10 | |
17 | ||
18 | library | |
19 | exposed-modules: Data.Aeson.Linked, | |
20 | Data.Aeson.Linked.Builder | |
21 | -- other-modules: | |
22 | -- other-extensions: | |
23 | build-depends: base >=4.8 && <4.9, aeson, text, bytestring, vector | |
24 | -- hs-source-dirs: | |
25 | default-language: Haskell2010 | |
26 | ||
27 | executable sample | |
28 | hs-source-dirs: sample | |
29 | main-is: Main.hs | |
30 | build-depends: base, aeson, aeson-ld, aeson-pretty, bytestring⏎ |
1 | {-# LANGUAGE OverloadedLists #-} | |
2 | {-# LANGUAGE OverloadedStrings #-} | |
3 | ||
4 | module Main where | |
5 | ||
6 | import Data.Aeson | |
7 | import Data.Aeson.Encode.Pretty (encodePretty) | |
8 | import Data.Aeson.Linked | |
9 | import Data.Aeson.Linked.Builder | |
10 | import qualified Data.ByteString.Lazy.Char8 as BS | |
11 | ||
12 | name, url, image :: LDField | |
13 | name = field "name" "http://schema.org/name" | |
14 | url = field "url" "http://schema.org/url" `withType` "@id" | |
15 | image = field "image" "http://schema.org/image" `withType` "@id" | |
16 | ||
17 | jsPrint :: Value -> IO () | |
18 | jsPrint = BS.putStrLn . encodePretty | |
19 | ||
20 | main :: IO () | |
21 | main = do | |
22 | let fields = | |
23 | [ ( name, "Getty Ritter" ) | |
24 | , ( url, "http://gdritter.com/" ) | |
25 | , ( image, "http://gdritter.com/imgs/gdritter.jpg" ) | |
26 | ] | |
27 | doc = unlinkedObject fields | |
28 | ctx = ldContext [name, url, image] | |
29 | ||
30 | jsPrint doc | |
31 | jsPrint ctx | |
32 | ||
33 | let compacted = compact doc ctx | |
34 | jsPrint compacted | |
35 | ||
36 | let expanded = expand compacted | |
37 | jsPrint expanded | |
38 | ||
39 | let flattened = flatten doc | |
40 | jsPrint flattened | |
41 | ||
42 | let framed = frame doc | |
43 | jsPrint framed | |
44 | ||
45 | let normalized = normalize doc | |
46 | jsPrint normalized |