Permalink
Browse files

Initial commit --- working in progress

  • Loading branch information...
dahlia committed May 10, 2016
0 parents commit da5f37f4d31280f4575a9570618836202a7753e7
674 LICENSE

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -0,0 +1,10 @@
Nirum
=====
Nirum is a [distributed object][1] framework/compiler for microservices,
built on top of the modern Web server technologies such as RESTful HTTP and
JSON.
WIP.
[1]: https://en.wikipedia.org/wiki/Distributed_object
@@ -0,0 +1,3 @@
import Distribution.Simple
main = defaultMain
@@ -0,0 +1,73 @@
# Introducing built-in types.
record number-types (
bigint a,
# `bigint` stores an arbitrary integer. Represented as a string in JSON.
decimal b,
# `decimal` stores an arbitrary real number.
# Represented as a string in JSON.
int32 c,
# `int32` stores a 32-bit signed integer. Represented as a number in JSON.
int64 d,
# `int64` stores a 64-bit signed integer. Represented as a number in JSON.
float32 e,
# `float32` stores a 32-bit signed floating number.
# Represented as a number in JSON.
float64 f,
# `float64` stores a 64-bit signed floating number.
# Represented as a number in JSON.
);
record string-types (
text a,
# `text` stores an arbitrary size of Unicode string.
# Represented as a string in JSON.
binary b,
# `binary` stores an arbitrary size of byte string.
# Represented as a base64 string in JSON.
);
record time-types (
date a,
# `date` stores a date assuming the Gregorian calendar.
# Represented as an ISO 8601 string in JSON.
datetime b,
# `datetime` stores a UTC date and time assuming the Gregorian calendar.
# Represented as an RFC 3339 string in JSON.
);
record et-cetera (
bool a,
# `bool` stores a boolean value. Represented as `true`/`false` in JSON.
uuid b,
# `uuid` stores a UUID. Represented as a string in JSON.
uri c,
# `uri` stores a URI. Represented as a string in JSON.
);
record containers (
bigint? a,
# Option stores an any value of the specified type, or an empty state
# i.e. null, nil, none. An empty state is represented as a `null` in JSON.
{bigint} b,
# Set stores an unordered set of unique elements.
# Represented as an array in JSON.
[bigint] c,
# List stores an ordered list of elements that some of them might be
# duplicated. Represented as an array in JSON.
{text: bigint} d,
# Map stores a map of unique keys to values.
# Represented as an array of arrays in JSON e.g. `[[k, v], [k2, v2], ...]`.
);
@@ -0,0 +1,19 @@
enum currency = krw
| jpy
| usd
;
record money (
currency currency,
decimal amount
);
record product (
text name,
money? price
);
record order (
{product: bigint} items,
datetime ordered-at
);
@@ -0,0 +1,44 @@
# Module consists zero or more type declarations.
boxed offset (float64);
# If there's only one field which omit its identifier in a value type,
# it's defined as a boxed type of the field type.
#
# The key difference between boxed type and value type consisting of single
# consturctor of a field is that the former has the same JSON representation
# to its boxing target type, while the latter has thicker JSON representation
# than its only field.
#
# For example, a boxed type `value offset (float);` is represented in JSON as:
#
# 120.5
#
# While a value type `value offset (float position);` is represented in JSON as:
#
# {"position": 120.5}
#
# What does it mean? It means you can safely change a value type `float`
# to its boxed type `offset` with backward compatibility.
record point (
# Value type definition `value t = t (...);` can be shortened as
# `value t (...);`.
offset left/x,
# for backward compatibility, you can specify *behind name*.
offset top,
# trailing comma is okay
);
union shape
# Type constructors in a sum type become translated to subtypes in OO
# languages, and datatypes in functional languages.
= rectangle (point upper-left, point lower-right)
| circle (point origin, offset radius)
;
// This is comment. Note that there are important differences between
// `#` comment syntax and `//` comment syntax: the former is for docs
// thus captured as AST, while the latter is for just comments thus eliminated
// after parsing.
@@ -0,0 +1,72 @@
name: nirum
version: 0.1.0
synopsis: Distributed object framework built on top of
REST HTTP and JSON
description: Distributed object framework for microservices,
built on top of RESTful HTTP and JSON
homepage: https://bitbucket.org/dahlia/nirum
bug-reports: https://bitbucket.org/dahlia/nirum/issues
license: GPL-3
license-file: LICENSE
author: Hong Minhee
maintainer: hongminhee@member.fsf.org
copyright: (c) 2016 Hong Minhee
stability: alpha
category: Language
build-type: Simple
extra-source-files: README.md
cabal-version: >=1.10
library
exposed-modules: Nirum.Constructs
, Nirum.Constructs.Declaration
, Nirum.Constructs.DeclarationSet
, Nirum.Constructs.Identifier
, Nirum.Constructs.Module
, Nirum.Constructs.Name
, Nirum.Constructs.TypeDeclaration
, Nirum.Constructs.TypeExpression
, Nirum.Parser
, Nirum.Targets.Python
build-depends: base >=4.7 && <5
, containers >=0.5.6.2 && <0.6
, interpolatedstring-perl6 >=1.0.0 && <1.1.0
, megaparsec >=4.4.0 && <5.0.0
, text >=0.9.1.0 && <1.3
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall -Werror -fwarn-incomplete-uni-patterns
test-suite spec
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
other-modules: Nirum.Constructs.DeclarationSpec
, Nirum.Constructs.DeclarationSetSpec
, Nirum.Constructs.IdentifierSpec
, Nirum.Constructs.ModuleSpec
, Nirum.Constructs.NameSpec
, Nirum.Constructs.TypeDeclarationSpec
, Nirum.Constructs.TypeExpressionSpec
, Nirum.ParserSpec
, Nirum.Targets.PythonSpec
default-language: Haskell2010
build-depends: base >=4.7 && <5
, directory
, hspec
, hspec-core
, hspec-meta
, megaparsec >=4.4.0 && <5.0.0
, nirum
, text >=0.9.1.0 && <1.3
ghc-options: -Wall -Werror
-fno-warn-incomplete-uni-patterns
-fno-warn-missing-signatures
test-suite hlint
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: HLint.hs
default-language: Haskell2010
build-depends: base >=4.7 && <5
, hlint >=1.9 && <2
@@ -0,0 +1,6 @@
module Nirum.Constructs (Construct, toCode) where
import Data.Text (Text)
class Ord a => Construct a where
toCode :: a -> Text
@@ -0,0 +1,49 @@
{-# LANGUAGE OverloadedStrings #-}
module Nirum.Constructs.Declaration ( Declaration
, Docs(Docs)
, docs
, name
, toCode
, toCodeWithPrefix
, toText
) where
import Data.String (IsString(fromString))
import qualified Data.Text as T
import Nirum.Constructs (Construct(toCode))
import Nirum.Constructs.Name (Name)
-- 'Construct' which has its own unique 'name' and can has its 'docs'.
class Construct a => Declaration a where
name :: a -> Name
docs :: a -> Maybe Docs
-- | Docstring for constructs.
data Docs = Docs T.Text deriving (Eq, Ord, Show)
-- | Convert the docs to text.
toText :: Docs -> T.Text
toText (Docs docs') = docs'
-- | Similar to 'toCode' except it takes 'Maybe Docs' instead of 'Docs'.
-- If the given docs is 'Nothing' it simply returns an empty string.
-- Otherwise it returns a code string with the prefix.
toCodeWithPrefix :: T.Text -- | The prefix to be prepended if not empty.
-> Maybe Docs -- | The docs to convert to code.
-> T.Text
toCodeWithPrefix _ Nothing = ""
toCodeWithPrefix prefix (Just docs') = T.append prefix $ toCode docs'
instance Construct Docs where
toCode (Docs docs') = let d = if "\n" `T.isSuffixOf` docs'
then T.dropEnd 1 docs'
else docs'
in T.append "# " $ T.replace "\n" "\n# " d
instance IsString Docs where
fromString s = let t = T.pack s
in Docs (if "\n" `T.isSuffixOf` t
then t
else t `T.snoc` '\n')
@@ -0,0 +1,104 @@
{-# LANGUAGE OverloadedLists, TypeFamilies #-}
module Nirum.Constructs.DeclarationSet ( DeclarationSet()
, NameDuplication( BehindNameDuplication
, FacialNameDuplication
)
, empty
, fromList
, lookup
, lookup'
, null
, null'
, size
, toList
, (!)
) where
import Data.Maybe (fromJust)
import qualified GHC.Exts as L
import Prelude hiding (lookup, null)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Nirum.Constructs.Declaration (Declaration(name))
import Nirum.Constructs.Identifier (Identifier)
import Nirum.Constructs.Name (Name(Name, behindName, facialName))
data Declaration a => DeclarationSet a
-- | The set of 'Declaration' values.
-- Every 'name' has to be unique in the set.
-- The order of declarations is maintained.
= DeclarationSet { declarations :: M.Map Identifier a
, index :: ![Identifier]
}
deriving (Eq, Ord, Show)
data NameDuplication = FacialNameDuplication !Name
| BehindNameDuplication !Name
deriving (Eq, Show)
empty :: Declaration a => DeclarationSet a
empty = DeclarationSet { declarations = M.empty
, index = []
}
fromList :: Declaration a => [a] -> Either NameDuplication (DeclarationSet a)
fromList declarations' =
case findDup names facialName S.empty of
Just dup -> Left $ FacialNameDuplication dup
_ -> case findDup names behindName S.empty of
Just dup -> Left $ BehindNameDuplication dup
_ -> Right DeclarationSet { declarations = M.fromList mapList
, index = index'
}
where
names :: [Name]
names = map name declarations'
index' :: [Identifier]
index' = map facialName names
mapList = [(facialName (name d), d) | d <- declarations']
findDup :: [Name] -> (Name -> Identifier) -> S.Set Identifier -> Maybe Name
findDup names' f dups =
case names' of
x:xs -> let name' = f x
in if name' `S.member` dups
then Just x
else findDup xs f $ S.insert name' dups
_ -> Nothing
toList :: Declaration a => DeclarationSet a -> [a]
toList (DeclarationSet declarations' index') =
map ((M.!) declarations') index'
size :: Declaration a => DeclarationSet a -> Int
size (DeclarationSet declarations' _) = M.size declarations'
null :: Declaration a => DeclarationSet a -> Bool
null = null'
null' :: Declaration a => DeclarationSet a -> Bool
null' (DeclarationSet declarations' _) = M.null declarations'
lookup :: Declaration a => Identifier -> DeclarationSet a -> Maybe a
lookup = lookup'
lookup' :: Declaration a => Identifier -> DeclarationSet a -> Maybe a
lookup' facialName' (DeclarationSet declarations' _) =
M.lookup facialName' declarations'
(!) :: Declaration a => DeclarationSet a -> Identifier -> a
declarationSet ! facialName' = fromJust $ lookup' facialName' declarationSet
instance (Declaration a) => L.IsList (DeclarationSet a) where
type Item (DeclarationSet a) = a
fromList declarations' =
case fromList declarations' of
Right set -> set
Left (FacialNameDuplication (Name fname _)) ->
error ("identifiers must be unique; " ++ show fname ++
" is defined more than once")
Left (BehindNameDuplication (Name _ bname)) ->
error ("behind names must be unique; " ++ show bname ++
" is defined more than once")
toList = toList
Oops, something went wrong.

0 comments on commit da5f37f

Please sign in to comment.