Moved UnitExp to Units.hs

LukasPietzschmann · Jul 17, 2024 · 532f4d3 · 532f4d3
1 parent 3eef04c
commit 532f4d3
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 16 deletions.
diff --git a/src/Math/Haskellator/Internal/TH/UnitGeneration.hs b/src/Math/Haskellator/Internal/TH/UnitGeneration.hs
@@ -115,23 +115,8 @@ generateUnits unitGroups = do
   convertBaseFunc <- funD convertToBaseFun convertBaseClauses
   mkUnitFuns      <- generateMkUnitFuns unitGroups
   isUnitFuns      <- generateIsUnitFuns unitGroups
-  unitExpDec      <- genUnitExp
 
-  return $ [dataDec, showInstance] ++ [fromStringSig, fromStringFunction, convertBaseSig, convertBaseFunc, convertToSig, convertToFunc] ++ isUnitFuns ++ unitExpDec ++ mkUnitFuns
-
-genUnitExp :: Q [Dec]
-genUnitExp = [d|
-  data UnitExp = UnitExp { dimUnit :: $(conT unitADT), power :: Int }
-    deriving Lift
-
-  instance Show UnitExp where
-    show (UnitExp u 1) = show u
-    show (UnitExp u i) = show u ++ "^" ++ show i
-
-  instance Eq UnitExp where
-    (UnitExp $(return $ ConP (mkName "Multiplier") [] []) _) == (UnitExp $(return $ ConP (mkName "Multiplier") [] []) _) = True
-    (UnitExp u1 i1) == (UnitExp u2 i2) = u1 == u2 && i1 == i2
-  |]
+  return $ [dataDec, showInstance, fromStringSig, fromStringFunction, convertBaseSig, convertBaseFunc, convertToSig, convertToFunc] ++ isUnitFuns ++ mkUnitFuns
 
 generateIsUnitFuns :: [Quantity] -> Q [Dec]
 generateIsUnitFuns unitGroups = concat <$> mapM mkIsUnitFun (concatMap (\(Quantity b us) -> b:us) unitGroups)

diff --git a/src/Math/Haskellator/Internal/Units.hs b/src/Math/Haskellator/Internal/Units.hs
@@ -8,6 +8,8 @@ module Math.Haskellator.Internal.Units where
 
 import Data.List (intercalate)
 
+import Language.Haskell.TH.Syntax
+
 import Math.Haskellator.Internal.TH.UnitGeneration
 
 $(generateUnits
@@ -52,6 +54,20 @@ $(generateUnits
     ]
   ])
 
+-- | An exponentiated unit
+data UnitExp = UnitExp { dimUnit :: Unit
+                       , power   :: Int
+                       }
+  deriving (Lift)
+
+instance Show UnitExp where
+    show (UnitExp u 1) = show u
+    show (UnitExp u e) = show u ++ "^" ++ show e
+
+instance Eq UnitExp where
+    (UnitExp Multiplier _) == (UnitExp Multiplier _) = True
+    (UnitExp u1 e1) == (UnitExp u2 e2)               = u1 == u2 && e1 == e2
+
 mapValue :: (Double -> Double) -> Value u -> Value u
 mapValue f (Value v u) = Value (f v) u