record-syntax (empty) → 0.1.0.0
raw patch · 14 files changed
+1376/−0 lines, 14 filesdep +basedep +base-preludedep +conversionbuild-type:Customsetup-changed
Dependencies added: base, base-prelude, conversion, conversion-text, directory, doctest, filepath, haskell-src-exts, hspec, parsec, record, record-syntax, template-haskell, text, transformers
Files
- LICENSE +22/−0
- Setup.hs +42/−0
- demo/Main.hs +13/−0
- doctest/Main.hs +66/−0
- hspec/Main.hs +8/−0
- library/Record/Syntax.hs +84/−0
- library/Record/Syntax/LevelReifier.hs +37/−0
- library/Record/Syntax/LevelReifier/Levels.hs +302/−0
- library/Record/Syntax/Parser.hs +380/−0
- library/Record/Syntax/Position.hs +32/−0
- library/Record/Syntax/Prelude.hs +66/−0
- library/Record/Syntax/Renderer.hs +85/−0
- library/Record/Syntax/Shared.hs +77/−0
- record-syntax.cabal +162/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,42 @@+-- The code is mostly ripped from+-- https://github.com/ekmett/lens/blob/697582fb9a980f273dbf8496253c5bbefedd0a8b/Setup.lhs+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+ let dir = autogenModulesDir lbi+ createDirectoryIfMissingVerbose verbosity True dir+ withLibLBI pkg lbi $ \_ libcfg -> do+ withTestLBI pkg lbi $ \suite suitecfg -> do+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+ [ "module Build_" ++ testName suite ++ " where"+ , "import Prelude"+ , "deps :: [String]"+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ ]+ where+ formatdeps = map (formatone . snd)+ formatone p = case packageName p of+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+
+ demo/Main.hs view
@@ -0,0 +1,13 @@+module Main where++import BasePrelude+import Record.Syntax+import Conversion+import Conversion.Text+import qualified Data.Text.IO as Text++main =+ either (putStrLn . showString "Error: " . show) (Text.putStrLn . convert) . processModule =<<+ Text.readFile "samples/1.hs"++
+ doctest/Main.hs view
@@ -0,0 +1,66 @@+-- The code is mostly ripped from+-- https://github.com/ekmett/lens/blob/d1d97469f0e93c1d3535308954a060e8a04e37aa/tests/doctests.hsc+import BasePrelude+import System.Directory+import System.FilePath+import Test.DocTest+import Build_doctest (deps)++main :: IO ()+main = do+ sources <- getSources+ doctest $ dfltParams ++ map ("-package="++) deps ++ sources+ where+ dfltParams = + [+ "-isrc",+ "-idist/build/autogen",+ "-optP-include",+ "-optPdist/build/autogen/cabal_macros.h",+ "-XArrows",+ "-XBangPatterns",+ "-XConstraintKinds",+ "-XDataKinds",+ "-XDefaultSignatures",+ "-XDeriveDataTypeable",+ "-XDeriveFunctor",+ "-XDeriveGeneric",+ "-XEmptyDataDecls",+ "-XFlexibleContexts",+ "-XFlexibleInstances",+ "-XFunctionalDependencies",+ "-XGADTs",+ "-XGeneralizedNewtypeDeriving",+ "-XImpredicativeTypes",+ "-XLambdaCase",+ "-XLiberalTypeSynonyms",+ "-XMultiParamTypeClasses",+ "-XMultiWayIf",+ "-XNoImplicitPrelude",+ "-XNoMonomorphismRestriction",+ "-XOverloadedStrings",+ "-XPatternGuards",+ "-XParallelListComp",+ "-XQuasiQuotes",+ "-XRankNTypes",+ "-XRecordWildCards",+ "-XScopedTypeVariables",+ "-XStandaloneDeriving",+ "-XTemplateHaskell",+ "-XTupleSections",+ "-XTypeFamilies",+ "-XTypeOperators",+ "-hide-all-packages"+ ]++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "library"+ where+ go dir = do+ (dirs, files) <- getFilesAndDirectories dir+ (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ hspec/Main.hs view
@@ -0,0 +1,8 @@+import BasePrelude+import Test.Hspec++main = + hspec $ do+ context "" $ do+ it "" $ do+ pending
+ library/Record/Syntax.hs view
@@ -0,0 +1,84 @@+module Record.Syntax where++import Record.Syntax.Prelude+import Record.Syntax.Shared+import qualified Record.Syntax.LevelReifier as LevelReifier+import qualified Record.Syntax.Position as Position+import qualified Record.Syntax.Parser as Parser+import qualified Record.Syntax.Renderer as Renderer+++processModule :: Text -> Either Error TextBuilder+processModule input =+ join $ runParser pass1Parser+ where+ runParser p =+ Parser.run p input+ pass1Parser =+ liftA2 mappend <$> fmap pure head <*> body+ where+ head =+ flip fmap Parser.moduleHead $ \(output, t) -> output <> "import qualified Record" <> ending t+ where+ ending = + \case+ Parser.LineType_Space -> ""+ Parser.LineType_Comment -> " "+ Parser.LineType_Import -> "; "+ Parser.LineType_Other -> "\n"+ body =+ do+ offset <- Parser.position+ forest <- Parser.total $ Parser.extendableSyntaxForest Parser.unparsedExtensionLexeme+ return $ processExtensionForest Level_Decl forest++process :: Level -> Text -> Either Error TextBuilder+process level input =+ do+ forest <- Parser.run parser $ input+ processExtensionForest level forest+ where+ parser =+ Parser.extendableSyntaxForest Parser.unparsedExtensionLexeme++processExtensionForest :: Level -> ExtendableSyntaxForest TextBuilder -> Either Error TextBuilder+processExtensionForest level forest =+ do+ levels <- reifyLevels level forest+ forest' <- zipTraversableWithM (\a b -> processExtension b (convert a)) forest levels+ return $ Renderer.extendableSyntaxForest id forest'+ where+ reifyLevels level =+ LevelReifier.reify level . convert .+ Renderer.extendableSyntaxForest (const marker)++processExtension :: Level -> Text -> Either Error TextBuilder+processExtension level input =+ join $ Parser.run (parser level) input+ where+ parser =+ \case+ Level_Exp -> fmap processExtensionExp Parser.extensionExp+ Level_Type -> fmap processExtensionType Parser.extensionType++processExtensionExp :: ExtensionExp (Position, TextBuilder) -> Either Error TextBuilder+processExtensionExp =+ \case+ ExtensionExp_Record x -> processRecordExp x+ ExtensionExp_Label x -> pure $ Renderer.labelExp x++processRecordExp :: RecordExp (Position, TextBuilder) -> Either Error TextBuilder+processRecordExp =+ fmap (Renderer.recordExp id) .+ traverse (\(p, i) -> offsetResult p $ process Level_Exp $ convert i)++processExtensionType :: ExtensionType -> Either Error TextBuilder+processExtensionType =+ \case+ ExtensionType_Record x -> pure $ Renderer.recordType x+++offsetResult :: Position -> Either Error a -> Either Error a+offsetResult p =+ either (Left . (\f (a, b) -> (f a, b)) (Position.add p)) Right+
+ library/Record/Syntax/LevelReifier.hs view
@@ -0,0 +1,37 @@+module Record.Syntax.LevelReifier+(+ reify,+)+where++import Record.Syntax.Prelude+import Record.Syntax.Shared+import qualified Language.Haskell.Exts as E+import qualified Record.Syntax.LevelReifier.Levels as Levels+++-- |+-- Parses the code using "haskell-src-exts", reifying the AST levels.+reify :: Level -> String -> Either Error [Level]+reify =+ fmap convertResult . \case+ Level_Decl -> fmap Levels.module_ . E.parseModuleWithMode parseMode+ Level_Type -> fmap Levels.type_ . E.parseTypeWithMode parseMode+ Level_Exp -> fmap Levels.exp . E.parseExpWithMode parseMode+ Level_Pat -> fmap Levels.pat . E.parsePatWithMode parseMode++parseMode :: E.ParseMode+parseMode =+ E.defaultParseMode {+ E.extensions = map (E.EnableExtension) (enumFrom minBound)+ }++convertResult :: E.ParseResult a -> Either Error a+convertResult =+ \case+ E.ParseOk a -> Right a+ E.ParseFailed l m -> Left (convertSrcLoc l, m)++convertSrcLoc :: E.SrcLoc -> Position+convertSrcLoc (E.SrcLoc _ l c) =+ (,) (fromIntegral l) (fromIntegral c)
+ library/Record/Syntax/LevelReifier/Levels.hs view
@@ -0,0 +1,302 @@+-- |+-- Reification of language levels at marker positions.+module Record.Syntax.LevelReifier.Levels where++import Record.Syntax.Prelude hiding (exp, bracket)+import Record.Syntax.Shared+import qualified Language.Haskell.Exts as E+++type Levels =+ [Level]++module_ :: E.Module -> Levels+module_ (E.Module _ _ _ _ _ _ decls) =+ foldMap decl decls++decl :: E.Decl -> Levels+decl = + \case+ E.TypeDecl _ _ _ t -> type_ t+ E.TypeFamDecl {} -> mempty+ E.ClosedTypeFamDecl _ _ _ _ tl -> foldMap typeEqn tl+ E.DataDecl _ _ c _ _ q d -> level c <> foldMap qualConDecl q <> foldMap deriving_ d+ E.GDataDecl _ _ c _ _ _ g d -> level c <> foldMap gadtDecl g <> foldMap deriving_ d+ E.DataFamDecl _ c _ _ _ -> level c+ E.TypeInsDecl _ t1 t2 -> type_ t1 <> type_ t2+ E.DataInsDecl _ _ t q d -> type_ t <> foldMap qualConDecl q <> foldMap deriving_ d+ E.GDataInsDecl _ _ t _ g d -> type_ t <> foldMap gadtDecl g <> foldMap deriving_ d+ E.ClassDecl _ c _ _ _ cd -> level c <> foldMap classDecl cd+ E.InstDecl _ _ _ c _ tl idl -> level c <> foldMap type_ tl <> foldMap instDecl idl+ E.DerivDecl _ _ _ c _ tl -> level c <> foldMap type_ tl+ E.InfixDecl {} -> mempty+ E.DefaultDecl _ tl -> foldMap type_ tl+ E.SpliceDecl _ e -> exp e+ E.TypeSig _ _ t -> type_ t+ E.FunBind ml -> foldMap match ml+ E.PatBind _ p r b -> pat p <> rhs r <> binds b+ E.ForImp _ _ _ _ _ t -> type_ t+ E.ForExp _ _ _ _ t -> type_ t+ E.RulePragmaDecl _ rl -> foldMap rule rl+ E.DeprPragmaDecl {} -> mempty+ E.WarnPragmaDecl {} -> mempty+ E.InlineSig {} -> mempty+ E.InlineConlikeSig {} -> mempty+ E.SpecSig _ _ _ tl -> foldMap type_ tl+ E.SpecInlineSig _ _ _ _ tl -> foldMap type_ tl+ E.InstSig _ _ c _ tl -> level c <> foldMap type_ tl+ E.AnnPragma {} -> mempty+ E.MinimalPragma {} -> mempty++rule :: E.Rule -> Levels+rule =+ \(E.Rule _ _ rvm e1 e2) -> (foldMap . foldMap) ruleVar rvm <> exp e1 <> exp e2++ruleVar :: E.RuleVar -> Levels+ruleVar =+ \case+ E.RuleVar _ -> mempty+ E.TypedRuleVar _ t -> type_ t++match :: E.Match -> Levels+match =+ \(E.Match _ _ pl tm r b) ->+ foldMap pat pl <> foldMap type_ tm <> rhs r <> binds b++rhs :: E.Rhs -> Levels+rhs =+ \case+ E.UnGuardedRhs e -> exp e+ E.GuardedRhss gl -> foldMap guardedRhs gl++guardedRhs :: E.GuardedRhs -> Levels+guardedRhs =+ \(E.GuardedRhs _ sl e) -> foldMap stmt sl <> exp e++instDecl :: E.InstDecl -> Levels+instDecl =+ \case+ E.InsDecl d -> decl d+ E.InsType _ t1 t2 -> type_ t1 <> type_ t2+ E.InsData _ _ t qcdl dl -> type_ t <> foldMap qualConDecl qcdl <> foldMap deriving_ dl+ E.InsGData _ _ t _ gdl dl -> type_ t <> foldMap gadtDecl gdl <> foldMap deriving_ dl++classDecl :: E.ClassDecl -> Levels+classDecl =+ \case+ E.ClsDecl d -> decl d+ E.ClsDataFam _ c _ _ _ -> level c+ E.ClsTyFam _ _ _ _ -> mempty+ E.ClsTyDef _ t1 t2 -> type_ t1 <> type_ t2+ E.ClsDefSig _ _ t -> type_ t++gadtDecl :: E.GadtDecl -> Levels+gadtDecl =+ \(E.GadtDecl _ _ pl t) -> foldMap (type_ . snd) pl <> type_ t++qualConDecl :: E.QualConDecl -> Levels+qualConDecl =+ \(E.QualConDecl _ _ c cd) -> level c <> conDecl cd++conDecl :: E.ConDecl -> Levels+conDecl =+ \case+ E.ConDecl _ tl -> foldMap type_ tl+ E.InfixConDecl t1 _ t2 -> type_ t1 <> type_ t2+ E.RecDecl {} -> error "Unexpected record declaration"++typeEqn :: E.TypeEqn -> Levels+typeEqn =+ \(E.TypeEqn t1 t2) -> type_ t1 <> type_ t2++deriving_ :: E.Deriving -> Levels+deriving_ =+ \(_, tl) -> foldMap type_ tl++type_ :: E.Type -> Levels+type_ =+ \case+ E.TyForall _ c t -> level c <> type_ t+ E.TyFun t1 t2 -> type_ t1 <> type_ t2+ E.TyTuple _ tl -> foldMap type_ tl+ E.TyList t -> type_ t+ E.TyParArray t -> type_ t+ E.TyApp t1 t2 -> type_ t1 <> type_ t2+ E.TyVar _ -> mempty+ E.TyCon n -> qName Level_Type n+ E.TyParen t -> type_ t+ E.TyInfix t1 _ t2 -> type_ t1 <> type_ t2+ E.TyKind t _ -> type_ t+ E.TyPromoted _ -> mempty+ E.TyEquals t1 t2 -> type_ t1 <> type_ t2+ E.TySplice s -> splice s+ E.TyBang _ t -> type_ t++level :: E.Context -> Levels+level =+ foldMap asst++asst :: E.Asst -> Levels+asst =+ \case+ E.ClassA _ tl -> foldMap type_ tl+ E.VarA _ -> mempty+ E.InfixA t1 _ t2 -> type_ t1 <> type_ t2+ E.IParam _ t -> type_ t+ E.EqualP t1 t2 -> type_ t1 <> type_ t2+ E.ParenA a -> asst a++qName :: Level -> E.QName -> Levels+qName c =+ \case+ E.UnQual n -> name c n+ _ -> mempty++name :: Level -> E.Name -> Levels+name c =+ \case+ E.Ident x | x == marker -> pure c+ E.Symbol x | x == marker -> pure c+ _ -> empty++splice :: E.Splice -> Levels+splice =+ \case+ E.IdSplice _ -> mempty+ E.ParenSplice e -> exp e++exp :: E.Exp -> Levels+exp =+ \case+ E.Var _ -> mempty+ E.IPVar _ -> mempty+ E.Con q -> qName Level_Exp q+ E.Lit _ -> mempty+ E.InfixApp e1 _ e2 -> exp e1 <> exp e2+ E.App e1 e2 -> exp e1 <> exp e2+ E.NegApp e -> exp e+ E.Lambda _ pl e -> foldMap pat pl <> exp e + E.Let b e -> binds b <> exp e+ E.If e1 e2 e3 -> exp e1 <> exp e2 <> exp e3+ E.MultiIf gl -> foldMap guardedRhs gl+ E.Case e al -> exp e <> foldMap alt al+ E.Do sl -> foldMap stmt sl+ E.MDo sl -> foldMap stmt sl+ E.Tuple _ el -> foldMap exp el+ E.TupleSection _ em -> (foldMap . foldMap) exp em+ E.List el -> foldMap exp el+ E.ParArray el -> foldMap exp el+ E.Paren e -> exp e+ E.LeftSection e _ -> exp e+ E.RightSection _ e -> exp e+ E.RecConstr {} -> error "Unexpected Haskell98 record construction expression"+ E.RecUpdate {} -> error "Unexpected Haskell98 record update expression"+ E.EnumFrom e -> exp e+ E.EnumFromTo e1 e2 -> exp e1 <> exp e2+ E.EnumFromThen e1 e2 -> exp e1 <> exp e2+ E.EnumFromThenTo e1 e2 e3 -> exp e1 <> exp e2 <> exp e3+ E.ParArrayFromTo e1 e2 -> exp e1 <> exp e2+ E.ParArrayFromThenTo e1 e2 e3 -> exp e1 <> exp e2 <> exp e3+ E.ListComp e stl -> exp e <> foldMap qualStmt stl+ E.ParComp e stll -> exp e <> (foldMap . foldMap) qualStmt stll+ E.ParArrayComp e stll -> exp e <> (foldMap . foldMap) qualStmt stll+ E.ExpTypeSig _ e t -> exp e <> type_ t+ E.VarQuote _ -> mempty+ E.TypQuote _ -> mempty+ E.BracketExp b -> bracket b+ E.SpliceExp s -> splice s+ E.QuasiQuote {} -> mempty+ E.XTag {} -> error "XML is not supported"+ E.XETag {} -> error "XML is not supported"+ E.XPcdata {} -> error "XML is not supported"+ E.XExpTag {} -> error "XML is not supported"+ E.XChildTag {} -> error "XML is not supported"+ E.CorePragma _ e -> exp e+ E.SCCPragma _ e -> exp e+ E.GenPragma _ _ _ e -> exp e+ E.Proc _ p e -> pat p <> exp e+ E.LeftArrApp e1 e2 -> exp e1 <> exp e2+ E.RightArrApp e1 e2 -> exp e1 <> exp e2+ E.LeftArrHighApp e1 e2 -> exp e1 <> exp e2+ E.RightArrHighApp e1 e2 -> exp e1 <> exp e2+ E.LCase al -> foldMap alt al++bracket :: E.Bracket -> Levels+bracket =+ \case+ E.ExpBracket e -> exp e+ E.PatBracket p -> pat p+ E.TypeBracket t -> type_ t+ E.DeclBracket dl -> foldMap decl dl++qualStmt :: E.QualStmt -> Levels+qualStmt =+ \case+ E.QualStmt s -> stmt s+ E.ThenTrans e -> exp e+ E.ThenBy e1 e2 -> exp e1 <> exp e2+ E.GroupBy e -> exp e+ E.GroupUsing e -> exp e+ E.GroupByUsing e1 e2 -> exp e1 <> exp e2++alt :: E.Alt -> Levels+alt =+ \case+ E.Alt _ p r b -> pat p <> rhs r <> binds b++pat :: E.Pat -> Levels+pat =+ \case+ E.PVar _ -> mempty+ E.PLit _ _ -> mempty+ E.PNPlusK _ _ -> mempty+ E.PInfixApp p1 _ p2 -> pat p1 <> pat p2+ E.PApp q pl -> qName Level_Pat q <> foldMap pat pl+ E.PTuple _ pl -> foldMap pat pl+ E.PList pl -> foldMap pat pl+ E.PParen p -> pat p+ E.PRec {} -> error "Unexpected record pattern"+ E.PAsPat _ p -> pat p+ E.PWildCard -> mempty+ E.PIrrPat p -> pat p+ E.PatTypeSig _ p t -> pat p <> type_ t+ E.PViewPat e p -> exp e <> pat p+ E.PRPat rl -> foldMap rPat rl+ E.PXTag {} -> error "XML is not supported"+ E.PXETag {} -> error "XML is not supported"+ E.PXPcdata {} -> error "XML is not supported"+ E.PXPatTag {} -> error "XML is not supported"+ E.PXRPats {} -> error "XML is not supported"+ E.PQuasiQuote _ _ -> mempty+ E.PBangPat p -> pat p++rPat :: E.RPat -> Levels+rPat =+ \case+ E.RPOp r _ -> rPat r+ E.RPEither r1 r2 -> rPat r1 <> rPat r2+ E.RPSeq rl -> foldMap rPat rl+ E.RPGuard p sl -> pat p <> foldMap stmt sl+ E.RPCAs _ r -> rPat r+ E.RPAs _ r -> rPat r+ E.RPParen r -> rPat r+ E.RPPat p -> pat p++stmt :: E.Stmt -> Levels+stmt =+ \case+ E.Generator _ p e -> pat p <> exp e+ E.Qualifier e -> exp e+ E.LetStmt b -> binds b+ E.RecStmt sl -> foldMap stmt sl++binds :: E.Binds -> Levels+binds =+ \case+ E.BDecls dl -> foldMap decl dl+ E.IPBinds il -> foldMap ipBind il++ipBind :: E.IPBind -> Levels+ipBind =+ \case+ E.IPBind _ _ e -> exp e
+ library/Record/Syntax/Parser.hs view
@@ -0,0 +1,380 @@+module Record.Syntax.Parser where++import Record.Syntax.Prelude hiding (try, takeWhile)+import Record.Syntax.Shared+import qualified Text.Parsec as P+import qualified Text.Parsec.Error as P+import qualified Data.Text.Lazy.Builder as TLB+import qualified Record.Syntax.Renderer as Renderer+import qualified Record.Syntax.Position as Position+++newtype Parser a =+ Parser (P.Parsec Text () a)+ deriving (Functor, Applicative, Monad, Alternative, MonadPlus)++instance Monoid a => Monoid (Parser a) where+ mempty = + pure mempty+ mappend (Parser a) (Parser b) = + Parser $ liftA2 mappend a b++run :: Parser a -> Text -> Either Error a+run (Parser p) =+ either (Left . convertError) Right .+ P.parse p ""+ where+ convertError =+ (,) <$> Position.fromParsec . P.errorPos <*> intercalate "; " . fmap P.messageString . P.errorMessages+++-- * Combinators+-------------------------++lookAhead :: Parser a -> Parser a+lookAhead (Parser p) =+ Parser $ P.lookAhead p++try :: Parser a -> Parser a+try (Parser p) =+ Parser $ P.try p++labeled :: String -> Parser a -> Parser a+labeled label (Parser p) =+ Parser $ P.label p label++total :: Parser a -> Parser a+total (Parser p) =+ Parser $ p <* P.eof++manyTill :: Parser a -> Parser b -> Parser [a]+manyTill (Parser a) (Parser b) =+ Parser $ P.manyTill a b++manyTillPair :: Parser a -> Parser b -> Parser ([a], b)+manyTillPair a b =+ fix $ \loop -> + ([],) <$> b <|> + (\a (al, b) -> (a : al, b)) <$> a <*> loop++manyTillMonoid :: Monoid a => Parser a -> Parser a -> Parser a+manyTillMonoid a b =+ fmap (\(c, d) -> mconcat c <> d) $+ manyTillPair a b++sepBy :: Parser a -> Parser b -> Parser [a]+sepBy (Parser a) (Parser b) =+ Parser $ P.sepBy a b++sepBy1 :: Parser a -> Parser b -> Parser [a]+sepBy1 (Parser a) (Parser b) =+ Parser $ P.sepBy1 a b++manyMerged :: Parser TextBuilder -> Parser TextBuilder+manyMerged =+ fmap mconcat . many+++-- * General+-------------------------++char :: Char -> Parser TextBuilder+char x =+ Parser $ P.char x $> TLB.singleton x++string :: String -> Parser TextBuilder+string x =+ Parser $ P.string x $> TLB.fromString x++space :: Parser TextBuilder+space =+ satisfy isSpace++spaces :: Parser TextBuilder+spaces =+ Parser $ TLB.fromString <$> many (P.satisfy isSpace)++spaces1 :: Parser TextBuilder+spaces1 =+ Parser $ TLB.fromString <$> P.many1 (P.satisfy isSpace)++nonEOLSpace :: Parser TextBuilder+nonEOLSpace =+ satisfy ((&&) <$> isSpace <*> not . flip elem ['\n', '\r'])++nonEOLSpaces :: Parser TextBuilder+nonEOLSpaces =+ manyMerged nonEOLSpace++satisfy :: (Char -> Bool) -> Parser TextBuilder+satisfy p =+ Parser $ TLB.singleton <$> P.satisfy p++takeWhile :: (Char -> Bool) -> Parser TextBuilder+takeWhile p =+ Parser $ TLB.fromString <$> P.many (P.satisfy p)++takeWhile1 :: (Char -> Bool) -> Parser TextBuilder+takeWhile1 p =+ Parser $ TLB.fromString <$> P.many1 (P.satisfy p)++anyChar :: Parser TextBuilder+anyChar =+ Parser $ TLB.singleton <$> P.anyChar++endOfLine :: Parser TextBuilder+endOfLine =+ string "\r\n" <|> char '\r' <|> char '\n'++endOfFile :: Parser TextBuilder+endOfFile =+ Parser $ P.eof $> mempty++noneOf :: [Char] -> Parser TextBuilder+noneOf =+ Parser . fmap TLB.singleton . P.noneOf+++-- * Domain-specific+-------------------------++position :: Parser Position.Position+position =+ Position.fromParsec <$> Parser P.getPosition++unparsedExtensionLexeme :: Parser TextBuilder+unparsedExtensionLexeme =+ unparsedRecordBlock True <|> unparsedRecordBlock False <|> unparsedLabel True <|> unparsedLabel False++unparsedRecordBlock :: Bool -> Parser TextBuilder+unparsedRecordBlock =+ block . bool lazyDelimiters strictDelimiters+ where+ strictDelimiters =+ (try (string "{!"), try (string "!}" <|> string "}"))+ lazyDelimiters =+ (try (string "{~"), try (string "~}" <|> string "}"))+ block (opening, closing) =+ opening <> manyTillMonoid plainTree closing++unparsedLabel :: Bool -> Parser TextBuilder+unparsedLabel uppercase =+ try (char '@' <> identifier uppercase)++recordExp :: Bool -> Parser (RecordExp (Position, TextBuilder))+recordExp strict =+ fmap RecordExp . (,) <$> pure strict <*> decls (bool lazyDelimiters strictDelimiters strict)+ where+ strictDelimiters =+ (try (string "{!"), try (spaces *> (string "!}" <|> string "}")))+ lazyDelimiters =+ (try (string "{~"), try (spaces *> (string "~}" <|> string "}")))+ decls (opening, closing) =+ opening *> spaces *> sepBy1 (assignment <|> nonAssignment) sep <* closing+ where+ sep =+ try $ spaces *> char ',' *> spaces+ assignment =+ (,) <$> try (identifier False <* spaces <* char '=' <* spaces) <*> + (fmap Just . (,) <$> position <*> value)+ where+ value =+ fmap mconcat $+ manyTill plainTree (lookAhead (void sep <|> void closing))+ nonAssignment =+ (,) <$> identifier False <*> pure Nothing++labelExp :: Parser Label+labelExp =+ char '@' *> (identifier False <|> identifier True)++extensionExp :: Parser (ExtensionExp (Position, TextBuilder))+extensionExp =+ ExtensionExp_Record <$> (recordExp True <|> recordExp False) <|>+ ExtensionExp_Label <$> labelExp++extensionType :: Parser ExtensionType+extensionType =+ ExtensionType_Record <$> (recordType True <|> recordType False)++recordType :: Bool -> Parser RecordType+recordType strict =+ (,) <$> pure strict <*> decls (bool lazyDelimiters strictDelimiters strict)+ where+ strictDelimiters =+ (try (string "{!"), try (spaces *> (string "!}" <|> string "}")))+ lazyDelimiters =+ (try (string "{~"), try (spaces *> (string "~}" <|> string "}")))+ decls (opening, closing) =+ opening *> spaces *> sepBy1 decl sep <* closing+ where+ decl =+ (,) <$> try (identifier False <* spaces <* string "::" <* spaces) <*> type_+ where+ type_ =+ fmap ExtendableSyntaxForest $+ manyTill (extendableSyntaxTree extensionType) (lookAhead (void sep <|> void closing))+ sep =+ try $ spaces *> char ',' *> spaces++type ModuleHead =+ (TextBuilder, LineType)++moduleHead :: Parser ModuleHead+moduleHead =+ labeled "moduleHead" $+ (,) <$> text <*> lookAheadLineType+ where+ text =+ spaces <> fmap mconcat (sepBy (pragma <|> blockComment <|> inlineComment) spaces) <> moduleDeclaration <>+ nonEOLSpaces <> (endOfLine <|> endOfFile)++data LineType =+ LineType_Space |+ LineType_Comment |+ LineType_Import |+ LineType_Other++lookAheadLineType :: Parser LineType+lookAheadLineType =+ lookAhead $+ LineType_Space <$ try (nonEOLSpaces *> (endOfLine <|> endOfFile)) <|>+ LineType_Comment <$ try (nonEOLSpaces *> (inlineComment <|> blockComment)) <|>+ LineType_Import <$ importStatement <|>+ LineType_Other <$ pure ()++moduleDeclaration :: Parser TextBuilder+moduleDeclaration =+ labeled "moduleDeclaration" $+ try (string "module" <> spaces1) <> + qualifiedIdentifier True <> + (try (spaces <> exportsBlock <> spaces) <|> spaces1) <>+ string "where"+ where+ exportsBlock =+ Renderer.recursiveBlock (const mempty) <$>+ recursiveBlock empty BraceType_Round++importStatement :: Parser TextBuilder+importStatement =+ labeled "importStatement" $+ try (string "import" <> spaces1) <>+ fmap (fromMaybe mempty) (try (optional (string "qualified" <> spaces1))) <>+ qualifiedIdentifier True++qualifiedIdentifier :: Bool -> Parser TextBuilder+qualifiedIdentifier uppercase =+ labeled "qualifiedIdentifier" $+ try ((try (manyMerged (identifier True <> char '.')) <|> mempty) <> identifier uppercase)++identifier :: Bool -> Parser TextBuilder+identifier uppercase =+ labeled "identifier" $+ try (satisfy (\c -> bool isLower isUpper uppercase c || c == '_' || c == '\'')) <>+ fmap mconcat (many bodyChar)+ where+ bodyChar = satisfy (flip any [isAlphaNum, (== '\''), (== '_')] . flip ($))++quasiQuote :: Parser TextBuilder+quasiQuote =+ labeled "quasiQuote" $+ try (char '[' <> qualifiedIdentifier False <> char '|') <> + manyTillMonoid anyChar (string "|]")++inlineComment :: Parser TextBuilder+inlineComment =+ labeled "inlineComment" $+ try (string "--") <> + fmap mconcat (manyTill anyChar (lookAhead (endOfLine <|> endOfFile))) <>+ (endOfLine <|> pure mempty)++blockComment :: Parser TextBuilder+blockComment =+ labeled "blockComment" $+ try (string "{-") <>+ fmap mconcat (manyTill anyChar (string "-}")) <>+ pure "-}"++pragma :: Parser TextBuilder+pragma =+ labeled "pragma" $+ try (string "{-#") <> manyTillMonoid anyChar (string "#-}")++charLit :: Parser TextBuilder+charLit =+ labeled "charLit" $ try $+ char '\'' <>+ (escapeSequence <|> noneOf "'\\") <>+ char '\''+ where+ escapeSequence =+ char '\\' <> (char '\'' <|> takeWhile1 isSequenceChar)+ where+ isSequenceChar =+ \c -> c /= '\'' && c /= '\\' && not (isSpace c)++stringLit :: Parser TextBuilder+stringLit =+ labeled "stringLit" $+ try (char '"') <> manyTillMonoid (escapedChar <|> anyChar) (char '"')+ where+ escapedChar =+ char '\\' <> anyChar++plainLexeme :: Parser TextBuilder+plainLexeme =+ charLit <|> stringLit <|> quasiQuote <|>+ blockComment <|> inlineComment++plainRecursiveSyntax :: Parser TextBuilder+plainRecursiveSyntax =+ labeled "plainRecursiveSyntax" $+ fmap mconcat $ many $+ plainLexeme <|>+ label True <|>+ label False <|>+ record True <|>+ record False <|>+ block <|>+ noneOf "[{()}]"+ where+ label uppercase =+ char '@' <> identifier uppercase+ record =+ recordBraces >>> \(i, o) -> + try (string i) <> fmap mconcat (many plainRecursiveSyntax) <> string o+ where+ recordBraces =+ bool ("{~", "~}") ("{!", "!}")+ block =+ msum $ flip map [('{', '}'), ('(', ')'), ('[', ']')] $ \(i, o) ->+ char i <> plainRecursiveSyntax <> char o++extendableSyntaxForest :: Parser a -> Parser (ExtendableSyntaxForest a)+extendableSyntaxForest p =+ fmap ExtendableSyntaxForest $ many $ extendableSyntaxTree p++extendableSyntaxTree :: Parser a -> Parser (ExtendableSyntaxTree a)+extendableSyntaxTree p =+ labeled "extendableSyntaxTree" $+ fmap ExtendableSyntaxTree_Extension p <|>+ fmap ExtendableSyntaxTree_RecursiveBlock recursiveBlockVariations <|>+ fmap ExtendableSyntaxTree_Lexeme lexeme+ where+ recursiveBlockVariations =+ msum (map (recursiveBlock p) [minBound .. maxBound])+ lexeme =+ charLit <|> stringLit <|> quasiQuote <|>+ blockComment <|> inlineComment <|> + satisfy (not . flip elem ("[{()}]" :: [Char]))++recursiveBlock :: Parser a -> BraceType -> Parser (RecursiveBlock a)+recursiveBlock p t =+ try $ (,) <$> pure t <*> (char i *> extendableSyntaxForest p <* char o)+ where+ (i, o) = braceTypeChars t++plainTree :: Parser TextBuilder+plainTree =+ Renderer.extendableSyntaxTree (const mempty) <$>+ extendableSyntaxTree empty
+ library/Record/Syntax/Position.hs view
@@ -0,0 +1,32 @@+module Record.Syntax.Position where++import Record.Syntax.Prelude+import qualified Text.Parsec as Parsec+import qualified Language.Haskell.Exts as SrcExts++type Position = + (Int, Int)++subtract :: Position -> Position -> Position+subtract (l1, c1) (l2, c2) =+ if l1 <= l2+ then (,) (l2 - l1) c2+ else (,) 0 (max (c2 - c1) 0)++add :: Position -> Position -> Position+add (l1, c1) (l2, c2) =+ if l2 <= 0+ then (,) (l1 + l2) (c1 + c2)+ else (,) (l1 + l2) c2++zero :: Position+zero =+ (0, 0)++fromParsec :: Parsec.SourcePos -> Position+fromParsec p =+ (,) (pred $ fromIntegral $ Parsec.sourceLine p) (pred $ fromIntegral $ Parsec.sourceColumn p)++fromSrcExts :: SrcExts.SrcLoc -> Position+fromSrcExts (SrcExts.SrcLoc _ l c) =+ (,) (fromIntegral l) (fromIntegral c)
+ library/Record/Syntax/Prelude.hs view
@@ -0,0 +1,66 @@+module Record.Syntax.Prelude+( + module Exports,+ LazyText,+ TextBuilder,+ (∘),+ (∘∘),+ zipTraversableWith,+ zipTraversableWithM,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (left, right, isLeft, isRight)++-- transformers+-------------------------+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Writer as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Maybe as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Class as Exports+import Control.Monad.IO.Class as Exports+import Data.Functor.Identity as Exports++-- text+-------------------------+import Data.Text as Exports (Text)++-- conversion+-------------------------+import Conversion as Exports+import Conversion.Text as Exports+++import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+++type LazyText = TL.Text+type TextBuilder = TLB.Builder+++(∘) :: (a -> b) -> (c -> a) -> (c -> b)+(∘) =+ (.)++(∘∘) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b)+(∘∘) a b =+ \c d -> a (b c d)+++zipTraversableWith :: (Traversable t1, Foldable t2) => (a1 -> a2 -> a3) -> t1 a1 -> t2 a2 -> t1 a3+zipTraversableWith f t1 t2 =+ flip evalState (toList t2) $ flip traverse t1 $ \a1 -> state $ \case+ a2 : tail -> (f a1 a2, tail)++zipTraversableWithM :: (Traversable t1, Foldable t2, Applicative m, Monad m) => (a1 -> a2 -> m a3) -> t1 a1 -> t2 a2 -> m (t1 a3)+zipTraversableWithM f t1 t2 =+ flip evalStateT (toList t2) $ flip traverse t1 $ \a1 -> StateT $ \case+ a2 : tail -> (,) <$> f a1 a2 <*> pure tail+++
+ library/Record/Syntax/Renderer.hs view
@@ -0,0 +1,85 @@+module Record.Syntax.Renderer where++import Record.Syntax.Prelude+import Record.Syntax.Shared+import qualified Data.Text.Lazy.Builder as TLB+++type Renderer a =+ a -> TextBuilder++extendableSyntaxForest :: Renderer a -> Renderer (ExtendableSyntaxForest a)+extendableSyntaxForest sub (ExtendableSyntaxForest list) =+ foldMap (extendableSyntaxTree sub) list++extendableSyntaxTree :: Renderer a -> Renderer (ExtendableSyntaxTree a)+extendableSyntaxTree sub =+ \case+ ExtendableSyntaxTree_Extension x -> sub x+ ExtendableSyntaxTree_RecursiveBlock x -> recursiveBlock sub x+ ExtendableSyntaxTree_Lexeme x -> x++recursiveBlock :: Renderer a -> Renderer (RecursiveBlock a)+recursiveBlock sub (bt, es) =+ convert i <> extendableSyntaxForest sub es <> convert o+ where+ (i, o) = braceTypeChars bt++recordExp :: Renderer a -> Renderer (RecordExp a)+recordExp sub (RecordExp (strict, sections)) =+ flip evalState 0 $ do+ sectionStrings <-+ forM sortedSections $ \(name, value) -> case value of+ Nothing -> do+ modify succ+ var <- fmap varName get+ return $ fieldNameExp name <> " " <> var+ Just a -> return $ fieldNameExp name <> " (" <> sub a <> ")"+ numArgs <- get+ let exp = + "(" <>+ bool "Record.lazyRecord" "Record.strictRecord" strict <> + convert (show (length sections)) <>+ " " <> mconcat (intersperse " " sectionStrings) <>+ ")"+ case numArgs of+ 0 -> return $ exp+ n -> return $ "\\" <> mconcat (intersperse " " (map varName [1 .. numArgs])) <> " -> " <> exp+ where+ varName n = + "ѣ" <> convert (show n)+ sortedSections =+ sortWith fst sections++labelExp :: Renderer Label+labelExp x =+ "(Record.fieldLens " <> fieldNameExp x <> ")"++fieldNameExp :: Renderer TextBuilder+fieldNameExp x =+ "(undefined :: Record.FieldName \"" <> x <> "\")"++recordType :: Renderer RecordType+recordType (strict, sections) =+ "(" <> recordName <> " " <> renderedSections <> ")"+ where+ recordName =+ basis <> arity+ where+ basis =+ if strict+ then "Record.StrictRecord"+ else "Record.LazyRecord"+ arity =+ convert $ show $ length sections+ renderedSections =+ mconcat (intersperse " " (map section (sortWith fst sections)))+ where+ section (name, forest) =+ "\"" <> name <> "\"" <> " " <> "(" <> extendableSyntaxForest extensionType forest <> ")"++extensionType :: Renderer ExtensionType+extensionType =+ \case+ ExtensionType_Record x -> recordType x+
@@ -0,0 +1,77 @@+module Record.Syntax.Shared where++import Record.Syntax.Prelude+++marker :: IsString a => a+marker =+ "Ѣ"+++type Error =+ (Position, String)+ ++type Position =+ (Int, Int)+++data Level =+ Level_Type |+ Level_Exp |+ Level_Pat |+ Level_Decl+ deriving (Show)+++data BraceType =+ BraceType_Curly | + BraceType_Round | + BraceType_Square+ deriving (Generic, Show, Eq, Ord, Enum, Bounded)++braceTypeChars :: BraceType -> (Char, Char)+braceTypeChars =+ \case+ BraceType_Curly -> ('{', '}')+ BraceType_Round -> ('(', ')')+ BraceType_Square -> ('[', ']')+ ++data ExtendableSyntaxTree a =+ ExtendableSyntaxTree_Extension a |+ ExtendableSyntaxTree_RecursiveBlock (RecursiveBlock a) |+ ExtendableSyntaxTree_Lexeme TextBuilder+ deriving (Show, Eq, Functor, Foldable, Traversable)+++newtype ExtendableSyntaxForest a =+ ExtendableSyntaxForest ([ExtendableSyntaxTree a])+ deriving (Show, Eq, Functor, Foldable, Traversable)+++type RecursiveBlock a =+ (BraceType, ExtendableSyntaxForest a)+++data ExtensionExp a =+ ExtensionExp_Record (RecordExp a) |+ ExtensionExp_Label Label+ deriving (Show, Eq, Functor, Foldable, Traversable)+++newtype RecordExp a =+ RecordExp (Bool, [(TextBuilder, Maybe a)])+ deriving (Show, Eq, Functor, Foldable, Traversable)+++type Label =+ TextBuilder+++data ExtensionType =+ ExtensionType_Record RecordType+++type RecordType =+ (Bool, [(TextBuilder, ExtendableSyntaxForest ExtensionType)])
+ record-syntax.cabal view
@@ -0,0 +1,162 @@+name:+ record-syntax+version:+ 0.1.0.0+synopsis:+ A library for parsing and processing the Haskell syntax sprinkled with anonymous records+category:+ Parser, Preprocessor, Syntax, Records+homepage:+ https://github.com/nikita-volkov/record-syntax +bug-reports:+ https://github.com/nikita-volkov/record-syntax/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2015, Nikita Volkov+license:+ MIT+license-file:+ LICENSE+build-type:+ Custom+cabal-version:+ >=1.10+++source-repository head+ type:+ git+ location:+ git://github.com/nikita-volkov/record-syntax.git+++flag doctest+ description: Build Doctests+ default: True+ manual: True+++library+ hs-source-dirs:+ library+ ghc-options:+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ other-modules:+ Record.Syntax.Position+ Record.Syntax.Shared+ Record.Syntax.LevelReifier+ Record.Syntax.LevelReifier.Levels+ Record.Syntax.Parser+ Record.Syntax.Renderer+ Record.Syntax.Prelude+ exposed-modules:+ Record.Syntax+ build-depends:+ -- + -- Despite not making a single import from that library,+ -- we need the following dependency to restrict the range of supported versions.+ record == 0.4.*,+ -- + haskell-src-exts == 1.16.*,+ parsec == 3.*,+ -- + conversion == 1.*,+ conversion-text == 1.*,+ text >= 1 && < 2,+ --+ template-haskell == 2.*,+ -- + transformers >= 0.2 && < 0.5,+ base-prelude >= 0.1.16 && < 0.2,+ base >= 4.6 && < 4.9+++test-suite doctest+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ doctest+ main-is:+ Main.hs+ ghc-options:+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+ default-language:+ Haskell2010+ if !flag(doctest)+ buildable: False+ build-depends:+ doctest == 0.9.*,+ directory == 1.2.*,+ filepath == 1.4.*,+ base-prelude,+ base+++test-suite hspec+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ hspec+ main-is:+ Main.hs+ ghc-options:+ -funbox-strict-fields+ -threaded+ "-with-rtsopts=-N"+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ -- + record,+ record-syntax,+ -- + hspec == 2.1.*,+ -- + base-prelude,+ base+++-- Well, it's not a benchmark actually, +-- but in Cabal there's no better way to specify an executable, +-- which is not intended for distribution.+benchmark demo+ type: + exitcode-stdio-1.0+ hs-source-dirs:+ demo+ main-is:+ Main.hs+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ -- + record,+ record-syntax,+ -- + conversion,+ conversion-text,+ text,+ -- + base-prelude++