diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +# Change Log + +All notable changes to this project will be documented in this file. +This project adheres to [Semantic Versioning](http://semver.org/). + +## 0.1.0.0 + +Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Alexander Bondarenko + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Alexander Bondarenko nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hedn-functor.cabal b/hedn-functor.cabal new file mode 100644 --- /dev/null +++ b/hedn-functor.cabal @@ -0,0 +1,45 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 1cbb3031d66621dd3df2ffb5ddcc3f8008ea5b198546c92e34ada8841fb71403 + +name: hedn-functor +version: 0.1.0.0 +synopsis: Base functor for EDN AST +description: Functor encoding for recursion schemes. + . + Mini-tutorial is available on package page: . +category: Data +author: Alexander Bondarenko +maintainer: aenor.realm@gmail.com +copyright: (c) 2019 Alexander Bondarenko +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + CHANGELOG.md + LICENSE + +source-repository head + type: git + location: https://gitlab.com/dpwiz/hedn + +library + exposed-modules: + Data.Functor.Base.EDN + other-modules: + Paths_hedn_functor + hs-source-dirs: + lib + ghc-options: -Wall + build-depends: + base >=4.9 && <4.13 + , containers >=0.5.7 && <0.7 + , hedn + , recursion-schemes >=5.0.1 && <6 + , text >=1.2 && <2 + , vector >=0.11 && <1 + default-language: Haskell2010 diff --git a/lib/Data/Functor/Base/EDN.hs b/lib/Data/Functor/Base/EDN.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Functor/Base/EDN.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.Functor.Base.EDN + ( ValueF(..) + ) where + +-- import Data.Deriving (deriveEq1, deriveShow1) +import Data.Functor.Foldable + ( Base + , Recursive(..) + , Corecursive(..) + ) +import Data.Text (Text) +import GHC.Generics (Generic) + +import qualified Data.Vector as V +import qualified Data.Map.Strict as M +import qualified Data.Set as S + +import Data.EDN.AST.Types (Tagged(..), Value(..)) + +type TextTag = Maybe (Text, Text) + +data ValueF f + = NilF TextTag + | BooleanF TextTag Bool + | StringF TextTag Text + | CharacterF TextTag Char + | SymbolF TextTag Text Text + | KeywordF TextTag Text + | IntegerF TextTag Int + | FloatingF TextTag Double + | ListF TextTag [f] + | VecF TextTag (V.Vector f) + | MapF TextTag [(f, f)] + | SetF TextTag [f] + deriving (Eq, Show, Generic, Functor, Foldable, Traversable) + +-- TODO: $(deriveEq1 ''ValueF) +-- TODO: $(deriveShow1 ''ValueF) + +type instance Base (Tagged Text Value) = ValueF + +instance Recursive (Tagged Text Value) where + project = \case + NoTag v -> projectV Nothing v + Tagged ns n v -> projectV (Just (ns, n)) v + where + projectV t = \case + Nil -> NilF t + Boolean b -> BooleanF t b + String s -> StringF t s + Character c -> CharacterF t c + Symbol ns n -> SymbolF t ns n + Keyword n -> KeywordF t n + Integer i -> IntegerF t i + Floating f -> FloatingF t f + List xs -> ListF t xs + Vec v -> VecF t v + Map m -> MapF t (M.toList m) + Set s -> SetF t (S.toList s) + +instance Corecursive (Tagged Text Value) where + embed = \case + NilF t -> embedT t Nil + BooleanF t b -> embedT t $ Boolean b + StringF t s -> embedT t $ String s + CharacterF t c -> embedT t $ Character c + SymbolF t ns n -> embedT t $ Symbol ns n + KeywordF t k -> embedT t $ Keyword k + IntegerF t i -> embedT t $ Integer i + FloatingF t f -> embedT t $ Floating f + ListF t xs -> embedT t $ List xs + VecF t v -> embedT t $ Vec v + MapF t ps -> embedT t $ Map (M.fromList ps) -- XXX: fromSomethingElse? + SetF t xs -> embedT t $ Set (S.fromList xs) -- XXX: fromAscList? + where + embedT t v = case t of + Nothing -> NoTag v + Just (ns, n) -> Tagged ns n v