packages feed

type-combinators-quote (empty) → 0.1.0.0

raw patch · 9 files changed

+377/−0 lines, 9 filesdep +basedep +haskell-src-metadep +template-haskellsetup-changed

Dependencies added: base, haskell-src-meta, template-haskell, type-combinators

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Kyle Carter++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 Kyle Carter 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Type/Fin/Quote.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-}++module Data.Type.Fin.Quote+  ( qF+  ) where++import Data.Type.Quote+import Data.Type.Fin+import Language.Haskell.TH+import Language.Haskell.TH.Quote++qF :: QuasiQuoter+qF = QuasiQuoter+  { quoteExp  = parseAsNatTerm qq varE [|FZ|]  $ \x -> [|FS $x|]+  , quotePat  = parseAsNatTerm qq varP [p|FZ|] $ \x -> [p|FS $x|]+  , quoteType = stub qq "quoteType"+  , quoteDec  = stub qq "quoteDec"+  }+  where+  qq = "qF"+
+ src/Data/Type/Index/Quote.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE LambdaCase #-}++module Data.Type.Index.Quote+  ( qI+  ) where++import Data.Type.Quote+import Data.Type.Index+import Language.Haskell.TH+import Language.Haskell.TH.Quote++qI :: QuasiQuoter+qI = QuasiQuoter+  { quoteExp  = parseAsNatTerm qq varE [|IZ|]  $ \x -> [|IS $x|]+  , quotePat  = parseAsNatTerm qq varP [p|IZ|] $ \x -> [p|IS $x|]+  , quoteType = stub qq "quoteType"+  , quoteDec  = stub qq "quoteDec"+  }+  where+  qq = "qI"+
+ src/Data/Type/Nat/Quote.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-}++module Data.Type.Nat.Quote+  ( qN+  ) where++import Data.Type.Quote+import Data.Type.Nat+import Type.Family.Nat+import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Control.Monad ((>=>))++qN :: QuasiQuoter+qN = QuasiQuoter+  { quoteExp  = parseAsNatTerm qq varE [|Z_|]  $ \x -> [|S_ $x|]+  , quotePat  = parseAsNatTerm qq varP [p|Z_|] $ \x -> [p|S_ $x|]+  , quoteType = parseAsNatTerm qq varT [t|Z|] $ \x -> [t|S $x|]+  , quoteDec  = stub qq "quoteDec"+  }+  where+  qq = "qN"+
+ src/Data/Type/Product/Quote.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}++module Data.Type.Product.Quote+  ( qP+  ) where++import Data.Type.Quote+import Data.Type.Product+import Language.Haskell.TH+import Language.Haskell.TH.Quote++qP :: QuasiQuoter+qP = QuasiQuoter+  { quoteExp  = parseProd (parseExp qq) prodExp+  , quotePat  = parseProd (parsePat qq) prodPat+  , quoteType = stub qq "quoteType not provided"+  , quoteDec  = stub qq "quoteDec not provided"+  }+  where+  qq = "qP"++parseProd :: (String -> Q a) -> ([Q a] -> Q a) -> String -> Q a+parseProd prs bld = bld . map prs . commaSep++prodExp :: [Q Exp] -> Q Exp+prodExp = \case+  e : es -> [| $e :< $(prodExp es) |]+  _      -> [| Ø |]++prodPat :: [Q Pat] -> Q Pat+prodPat = \case+  e : es -> [p| $e :< $(prodPat es) |]+  _      -> [p| Ø |]+
+ src/Data/Type/Quote.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Data.Type.Quote where++import Control.Arrow+import Language.Haskell.TH+import qualified Data.List as L+import Data.Maybe (maybeToList)+import Type.Family.Nat+import Text.Read (readMaybe)+import Data.Char (isSpace)+import qualified Language.Haskell.Meta.Parse as P+import Control.Monad ((>=>),(<=<))++failFrom :: Monad m => String -> String -> m a+failFrom src msg = fail $ src ++ ": " ++ msg++stub :: String -> String -> a -> Q b+stub qq fn _ = failFrom qq $ fn ++ " not provided"++-- Parsers {{{++parseExp :: String -> String -> Q Exp+parseExp qq = eitherM qq . P.parseExp++parsePat :: String -> String -> Q Pat+parsePat qq = eitherM qq . P.parsePat++parseType :: String -> String -> Q Type+parseType qq = eitherM qq . P.parseType++parseDecs :: String -> String -> Q [Dec]+parseDecs qq = eitherM qq . P.parseDecs++-- }}}++-- Nat Util {{{++parseN :: Monad m => String -> String -> m N+parseN qq = maybe+  (failFrom qq "couldn't parse number")+  (notNeg qq)+  . readMaybe++notNeg :: Monad m => String -> Int -> m N+notNeg qq n = maybe+  (failFrom qq $ "negative number: " ++ show n)+  return+  $ fromInt n++-- }}}++eitherM :: Monad m => String -> Either String a -> m a+eitherM qq = either (failFrom qq) return++maybeM :: Monad m => String -> String -> Maybe a -> m a+maybeM qq msg = maybe (failFrom qq msg) return++-- List Util {{{++readMaybeList :: Read a => String -> [a]+readMaybeList = maybeToList . readMaybe++commaSep :: String -> [String]+commaSep = map (strip isSpace) . breakOnAll ","++strip :: (a -> Bool) -> [a] -> [a]+strip pr = L.dropWhileEnd pr . dropWhile pr++breakOnAll :: Eq a => [a] -> [a] -> [[a]]+breakOnAll b as = b1 : case rest of+  [] -> []+  _  -> breakOnAll b rest+  where+  (b1,rest) = breakOn b as++breakOn :: Eq a => [a] -> [a] -> ([a],[a])+breakOn b = \case+  []           -> ([],[])+  as@(a : as') -> case getPrefix b as of+    Just sf -> ([],sf)+    _       -> first (a:) $ breakOn b as'++getPrefix :: Eq a => [a] -> [a] -> Maybe [a]+getPrefix p as+  | L.isPrefixOf p as = Just $ drop (length p) as+  | otherwise          = Nothing++-- }}}++-- AddTerm {{{++data AddTerm a+  = Simple a+  | Add String a+  deriving (Eq,Ord,Show,Functor,Foldable,Traversable)++instance (a ~ Int) => Read (AddTerm a) where+  readsPrec d s0 =+    [ (Add x i,s3)+    | (x,s1)   <- lex s0+    , ("+",s2) <- lex s1+    , (i,s3)   <- reads s2+    ] +++    [ (Simple i,s1)+    | (i,s1)   <- reads s0+    ]++parseAddTerm :: Monad m => String -> String -> m (AddTerm N)+parseAddTerm qq = traverse (notNeg qq)+  <=< maybeM qq "couldn't parse AddTerm"+    . readMaybe++fromAddTerm :: b -> (String -> b) -> (b -> a -> Q c) -> AddTerm a -> Q c+fromAddTerm simp var f = \case+  Simple a -> f simp    a+  Add x  a -> f (var x) a++parseAsNatTerm :: forall a. String+                  -> (Name -> Q a)+                  -> Q a -> (Q a -> Q a)+                  -> String -> Q a+parseAsNatTerm qq v z s = parseAddTerm qq >=> fromAddTerm z (v . mkName) go+  where+  go :: Q a -> N -> Q a+  go x = \case+    Z   -> x+    S n -> s $ go x n++-- }}}+
+ src/Data/Type/Sym/Quote.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE LambdaCase #-}++module Data.Type.Sym.Quote+  ( qS+  ) where++import Data.Type.Quote+import Data.Type.Sym+import Language.Haskell.TH+import Language.Haskell.TH.Quote++qS :: QuasiQuoter+qS = QuasiQuoter+  { quoteExp  = parseSymExp+  , quotePat  = stub qq "quotePat"+  , quoteType = parseSymType+  , quoteDec  = stub qq "quoteDec"+  }+  where+  qq = "qS"++parseSymExp :: String -> Q Exp+parseSymExp s = [| Sym :: $(parseSymType s) |]++parseSymType :: String -> Q Type+parseSymType s = [t| Sym $(litT $ strTyLit s) |]+
+ type-combinators-quote.cabal view
@@ -0,0 +1,32 @@+name:                type-combinators-quote+version:             0.1.0.0+synopsis:            Quasiquoters for the 'type-combinators' package.+license:             BSD3+license-file:        LICENSE+author:              Kyle Carter+maintainer:          kylcarte@gmail.com+copyright:           (c) 2015 Kyle Carter, all rights reserved+category:            Data+build-type:          Simple+cabal-version:       >=1.10+homepage: https://github.com/kylcarte/type-combinators-quote++Source-Repository head+    type: git+    location: git://github.com/kylcarte/type-combinators-quote.git++library+  exposed-modules:+    Data.Type.Fin.Quote+    Data.Type.Sym.Quote+    Data.Type.Nat.Quote+    Data.Type.Index.Quote+    Data.Type.Product.Quote+    Data.Type.Quote+  build-depends:+    base >=4.8 && <4.9,+    type-combinators >=0.2,+    template-haskell,+    haskell-src-meta+  hs-source-dirs:      src+  default-language:    Haskell2010