Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Support nix flakes #157

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,4 +5,5 @@ http/cql-http.cabal
.DS_Store
*.yaml#
*.cql#
dist-newstyle/

54 changes: 0 additions & 54 deletions cql.nix

This file was deleted.

86 changes: 0 additions & 86 deletions default.nix

This file was deleted.

41 changes: 41 additions & 0 deletions flake.nix
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
{
# This is a template created by `hix init`
inputs.haskellNix.url = "github:input-output-hk/haskell.nix";
inputs.nixpkgs.follows = "haskellNix/nixpkgs-unstable";
inputs.flake-utils.url = "github:numtide/flake-utils";
outputs = { self, nixpkgs, flake-utils, haskellNix }:
let
supportedSystems = [
"x86_64-linux"
"x86_64-darwin"
"aarch64-linux"
"aarch64-darwin"
];
in
flake-utils.lib.eachSystem supportedSystems (system:
let
overlays = [ haskellNix.overlay
(final: prev: {
hixProject =
final.haskell-nix.hix.project {
src = ./.;
evalSystem = "x86_64-darwin";
};
})
];
pkgs = import nixpkgs { inherit system overlays; inherit (haskellNix) config; };
flake = pkgs.hixProject.flake {};
in flake // {
legacyPackages = pkgs;
});

# --- Flake Local Nix Configuration ----------------------------
nixConfig = {
# This sets the flake to use the IOG nix cache.
# Nix should ask for permission before using it,
# but remove it here if you do not want it to.
extra-substituters = ["https://cache.iog.io"];
extra-trusted-public-keys = ["hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ="];
allow-import-from-derivation = "true";
};
}
3 changes: 2 additions & 1 deletion http/src/Api/Config/Environment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE DerivingStrategies #-}
module Api.Config.Environment where

-- wai
Expand All @@ -29,7 +30,7 @@ import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
data Environment
= Development
| Production
deriving (Show, Read)
deriving stock (Show, Read)

logger :: Environment -> Middleware
logger Development = logStdoutDev
Expand Down
17 changes: 17 additions & 0 deletions nix/hix.nix
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
{pkgs, ...}: {
# name = "project-name";
compiler-nix-name = "ghc8107"; # Version of GHC to use

# Cross compilation support:
# crossPlatforms = p: pkgs.lib.optionals pkgs.stdenv.hostPlatform.isx86_64 ([
# p.mingwW64
# p.ghcjs
# ] ++ pkgs.lib.optionals pkgs.stdenv.hostPlatform.isLinux [
# p.musl64
# ]);

# Tools to include in the development shell
shell.tools.cabal = "latest";
# shell.tools.hlint = "latest";
# shell.tools.haskell-language-server = "latest";
}
3 changes: 3 additions & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -64,11 +64,14 @@ ghc-options:
- -Wno-missing-export-lists
- -Wno-missing-import-lists
- -Wno-safe
- -Wno-missing-safe-haskell-mode
- -Wno-missing-local-signatures
- -Wno-unsafe
- -Wno-monomorphism-restriction
- -Wno-unused-type-patterns
- -Wno-name-shadowing
- -Wno-prepositive-qualified-module
- -Wno-unused-packages

executables:
cql:
Expand Down
29 changes: 15 additions & 14 deletions src/Language/CQL/Collage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,22 +21,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE InstanceSigs #-}

{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}

module Language.CQL.Collage where

Expand All @@ -60,7 +61,7 @@ data Collage var ty sym en fk att gen sk
, catts :: Map att (en , ty)
, cgens :: Map gen en
, csks :: Map sk ty
} deriving (Eq, Show)
} deriving stock (Eq, Show)

--------------------------------------------------------------------------------

Expand Down Expand Up @@ -95,12 +96,12 @@ eqsAreGround col = Prelude.null [ x | x <- Set.toList $ ceqs col, not $ Map.null
fksFrom :: Eq en => Collage var ty sym en fk att gen sk -> en -> [(fk,en)]
fksFrom sch en' = f $ Map.assocs $ cfks sch
where f [] = []
f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : (f l) else f l
f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : f l else f l

attsFrom :: Eq en => Collage var ty sym en fk att gen sk -> en -> [(att,ty)]
attsFrom sch en' = f $ Map.assocs $ catts sch
where f [] = []
f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : (f l) else f l
f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : f l else f l

-- TODO Carrier is duplicated here from Instance.Algebra (Carrier) because it is used in assembleGens.
type Carrier en fk gen = Term Void Void Void en fk Void gen Void
Expand Down Expand Up @@ -176,23 +177,23 @@ typeOf' col _ (Sk s) = case Map.lookup s $ csks col of
typeOf' col ctx xx@(Fk f a) = case Map.lookup f $ cfks col of
Nothing -> Left $ "Unknown foreign key: " ++ show f
Just (s, t) -> do s' <- typeOf' col ctx a
if (Right s) == s' then pure $ Right t else Left $ "Expected argument to have entity " ++
show s ++ " but given " ++ show s' ++ " in " ++ (show xx)
if Right s == s' then pure $ Right t else Left $ "Expected argument to have entity " ++
show s ++ " but given " ++ show s' ++ " in " ++ show xx
typeOf' col ctx xx@(Att f a) = case Map.lookup f $ catts col of
Nothing -> Left $ "Unknown attribute: " ++ show f
Just (s, t) -> do s' <- typeOf' col ctx a
if (Right s) == s' then pure $ Left t else Left $ "Expected argument to have entity " ++
show s ++ " but given " ++ show s' ++ " in " ++ (show xx)
if Right s == s' then pure $ Left t else Left $ "Expected argument to have entity " ++
show s ++ " but given " ++ show s' ++ " in " ++ show xx
typeOf' col ctx xx@(Sym f a) = case Map.lookup f $ csyms col of
Nothing -> Left $ "Unknown function symbol: " ++ show f
Just (s, t) -> do s' <- mapM (typeOf' col ctx) a
if length s' == length s
then if (Left <$> s) == s'
then pure $ Left t
else Left $ "Expected arguments to have types " ++
show s ++ " but given " ++ show s' ++ " in " ++ (show $ xx)
show s ++ " but given " ++ show s' ++ " in " ++ show xx
else Left $ "Expected argument to have arity " ++
show (length s) ++ " but given " ++ show (length s') ++ " in " ++ (show $ xx)
show (length s) ++ " but given " ++ show (length s') ++ " in " ++ show xx

typeOfEq'
:: (MultiTyMap '[Show, Ord, NFData] '[var, ty, sym, en, fk, att, gen, sk])
Expand Down
10 changes: 5 additions & 5 deletions src/Language/CQL/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,17 +37,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}

module Language.CQL.Common where

import Control.Arrow (left)
import Data.Char
import Data.Foldable as Foldable (foldl, toList)
import Data.Foldable as Foldable (toList)
import Data.Kind
import Data.Map.Strict as Map hiding (foldl)
import Data.Maybe
import Data.Set as Set (Set, empty, insert, member, singleton)
import Data.String (lines)
import Data.Typeable

split' :: [(a, Either b1 b2)] -> ([(a, b1)], [(a, b2)])
Expand Down Expand Up @@ -101,7 +101,7 @@ note :: b -> Maybe a -> Either b a
note n = maybe (Left n) Right

data Kind = CONSTRAINTS | TYPESIDE | SCHEMA | INSTANCE | MAPPING | TRANSFORM | QUERY | COMMAND | GRAPH | COMMENT | SCHEMA_COLIMIT
deriving (Show, Eq, Ord)
deriving stock (Show, Eq, Ord)

type ID = Integer

Expand Down Expand Up @@ -153,7 +153,7 @@ mergeMaps = foldl Map.union Map.empty
-- `(Show a, Show b, Show c)`
-- The drawback of using this is that the compiler will treat this as a unique
-- constraint, so it won't be able to detect specific unused constraints
type family TyMap (f :: * -> Constraint) (xs :: [*]) :: Constraint
type family TyMap (f :: Type -> Constraint) (xs :: [Type]) :: Constraint
type instance TyMap f '[] = ()
type instance TyMap f (t ': ts) = (f t, TyMap f ts)

Expand All @@ -163,6 +163,6 @@ type instance TyMap f (t ': ts) = (f t, TyMap f ts)
-- `(Show a, Ord a, Show b, Ord b, Show c, Ord c)`
-- The drawback of using this is that the compiler will treat this as a unique
-- constraint, so it won't be able to detect specific unused constraints
type family MultiTyMap (fs :: [* -> Constraint]) (xs :: [*]) :: Constraint
type family MultiTyMap (fs :: [Type -> Constraint]) (xs :: [Type]) :: Constraint
type instance MultiTyMap '[] _ = ()
type instance MultiTyMap (f : fs) xs = (TyMap f xs, MultiTyMap fs xs)
4 changes: 2 additions & 2 deletions src/Language/CQL/Graph.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,12 +18,12 @@ GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}

{-# LANGUAGE DerivingStrategies #-}
module Language.CQL.Graph where

import Prelude

data Graph a = Graph { vertices :: [a], edges :: [(a, a)] } deriving Show
data Graph a = Graph { vertices :: [a], edges :: [(a, a)] } deriving stock Show

removeEdge :: (Eq a) => (a, a) -> Graph a -> Graph a
removeEdge x (Graph v e) = Graph v (filter (/=x) e)
Expand Down
Loading